mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
Add "mod" field to tree-il toplevel ref, set, define
Add "mod" field to <toplevel-ref>, <toplevel-set>, and <toplevel-define>, indicating the expander's idea of what the current module is when a toplevel variable is accessed or created. This will help in later optimizations. * libguile/expand.c (TOPLEVEL_REF, TOPLEVEL_SET, TOPLEVEL_DEFINE) (expand, expand_define, expand_set_x, convert_assignment): * libguile/expand.h (SCM_EXPANDED_TOPLEVEL_REF_FIELD_NAMES): (SCM_MAKE_EXPANDED_TOPLEVEL_REF, SCM_EXPANDED_TOPLEVEL_SET_FIELD_NAMES): (SCM_MAKE_EXPANDED_TOPLEVEL_SET, SCM_EXPANDED_TOPLEVEL_DEFINE_FIELD_NAMES): (SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE): * module/ice-9/compile-psyntax.scm (translate-literal-syntax-objects): * module/ice-9/psyntax-pp.scm: * module/ice-9/psyntax.scm: * module/language/tree-il.scm: * module/language/tree-il.scm (parse-tree-il, make-tree-il-folder): (pre-post-order): * module/language/tree-il/analyze.scm (goops-toplevel-definition): (macro-use-before-definition-analysis, proc-ref?, format-analysis): * module/language/tree-il/compile-cps.scm (convert): * module/language/tree-il/debug.scm (verify-tree-il): * module/language/tree-il/effects.scm (make-effects-analyzer): * module/language/tree-il/fix-letrec.scm (free-variables): * module/language/tree-il/peval.scm (peval): * test-suite/tests/tree-il.test: Adapt uses.
This commit is contained in:
Andy Wingo
parent
4bb5834d75
commit
79a40cf717
13 changed files with 182 additions and 156 deletions
|
|
@ -74,12 +74,12 @@ static const char** exp_field_names[SCM_NUM_EXPANDED_TYPES];
|
|||
SCM_MAKE_EXPANDED_MODULE_REF(src, mod, name, public)
|
||||
#define MODULE_SET(src, mod, name, public, exp) \
|
||||
SCM_MAKE_EXPANDED_MODULE_SET(src, mod, name, public, exp)
|
||||
#define TOPLEVEL_REF(src, name) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name)
|
||||
#define TOPLEVEL_SET(src, name, exp) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp)
|
||||
#define TOPLEVEL_DEFINE(src, name, exp) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp)
|
||||
#define TOPLEVEL_REF(src, mod, name) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, mod, name)
|
||||
#define TOPLEVEL_SET(src, mod, name, exp) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, mod, name, exp)
|
||||
#define TOPLEVEL_DEFINE(src, mod, name, exp) \
|
||||
SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, mod, name, exp)
|
||||
#define CONDITIONAL(src, test, consequent, alternate) \
|
||||
SCM_MAKE_EXPANDED_CONDITIONAL(src, test, consequent, alternate)
|
||||
#define PRIMCALL(src, name, exps) \
|
||||
|
|
@ -377,7 +377,7 @@ expand (SCM exp, SCM env)
|
|||
if (scm_is_true (gensym))
|
||||
return LEXICAL_REF (SCM_BOOL_F, exp, gensym);
|
||||
else
|
||||
return TOPLEVEL_REF (SCM_BOOL_F, exp);
|
||||
return TOPLEVEL_REF (SCM_BOOL_F, SCM_BOOL_F, exp);
|
||||
}
|
||||
else
|
||||
return CONST_ (SCM_BOOL_F, exp);
|
||||
|
|
@ -552,13 +552,14 @@ expand_define (SCM expr, SCM env)
|
|||
ASSERT_SYNTAX_2 (scm_is_symbol (CAR (variable)), s_bad_variable, variable, expr);
|
||||
return TOPLEVEL_DEFINE
|
||||
(scm_source_properties (expr),
|
||||
SCM_BOOL_F,
|
||||
CAR (variable),
|
||||
expand_lambda (scm_cons (scm_sym_lambda, scm_cons (CDR (variable), body)),
|
||||
env));
|
||||
}
|
||||
ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
|
||||
ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
|
||||
return TOPLEVEL_DEFINE (scm_source_properties (expr), variable,
|
||||
return TOPLEVEL_DEFINE (scm_source_properties (expr), SCM_BOOL_F, variable,
|
||||
expand (CAR (body), env));
|
||||
}
|
||||
|
||||
|
|
@ -1143,6 +1144,7 @@ expand_set_x (SCM expr, SCM env)
|
|||
expand (CADDR (expr), env));
|
||||
case SCM_EXPANDED_TOPLEVEL_REF:
|
||||
return TOPLEVEL_SET (scm_source_properties (expr),
|
||||
SCM_EXPANDED_REF (vmem, TOPLEVEL_REF, MOD),
|
||||
SCM_EXPANDED_REF (vmem, TOPLEVEL_REF, NAME),
|
||||
expand (CADDR (expr), env));
|
||||
case SCM_EXPANDED_MODULE_REF:
|
||||
|
|
@ -1371,12 +1373,14 @@ convert_assignment (SCM exp, SCM assigned)
|
|||
case SCM_EXPANDED_TOPLEVEL_SET:
|
||||
return TOPLEVEL_SET
|
||||
(REF (exp, TOPLEVEL_SET, SRC),
|
||||
REF (exp, TOPLEVEL_SET, MOD),
|
||||
REF (exp, TOPLEVEL_SET, NAME),
|
||||
convert_assignment (REF (exp, TOPLEVEL_SET, EXP), assigned));
|
||||
|
||||
case SCM_EXPANDED_TOPLEVEL_DEFINE:
|
||||
return TOPLEVEL_DEFINE
|
||||
(REF (exp, TOPLEVEL_DEFINE, SRC),
|
||||
REF (exp, TOPLEVEL_DEFINE, MOD),
|
||||
REF (exp, TOPLEVEL_DEFINE, NAME),
|
||||
convert_assignment (REF (exp, TOPLEVEL_DEFINE, EXP),
|
||||
assigned));
|
||||
|
|
|
|||
|
|
@ -175,41 +175,44 @@ enum
|
|||
|
||||
#define SCM_EXPANDED_TOPLEVEL_REF_TYPE_NAME "toplevel-ref"
|
||||
#define SCM_EXPANDED_TOPLEVEL_REF_FIELD_NAMES \
|
||||
{ "src", "name", }
|
||||
{ "src", "mod", "name", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_REF_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_REF_MOD,
|
||||
SCM_EXPANDED_TOPLEVEL_REF_NAME,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, name) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_REF], 0, SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name))
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_REF(src, mod, name) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_REF], 0, SCM_NUM_EXPANDED_TOPLEVEL_REF_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name))
|
||||
|
||||
#define SCM_EXPANDED_TOPLEVEL_SET_TYPE_NAME "toplevel-set"
|
||||
#define SCM_EXPANDED_TOPLEVEL_SET_FIELD_NAMES \
|
||||
{ "src", "name", "exp", }
|
||||
{ "src", "mod", "name", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_SET_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_SET_MOD,
|
||||
SCM_EXPANDED_TOPLEVEL_SET_NAME,
|
||||
SCM_EXPANDED_TOPLEVEL_SET_EXP,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_SET], 0, SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_SET(src, mod, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_SET], 0, SCM_NUM_EXPANDED_TOPLEVEL_SET_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_TOPLEVEL_DEFINE_TYPE_NAME "toplevel-define"
|
||||
#define SCM_EXPANDED_TOPLEVEL_DEFINE_FIELD_NAMES \
|
||||
{ "src", "name", "exp", }
|
||||
{ "src", "mod", "name", "exp", }
|
||||
enum
|
||||
{
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_SRC,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_MOD,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_NAME,
|
||||
SCM_EXPANDED_TOPLEVEL_DEFINE_EXP,
|
||||
SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS,
|
||||
};
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_DEFINE], 0, SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
#define SCM_MAKE_EXPANDED_TOPLEVEL_DEFINE(src, mod, name, exp) \
|
||||
scm_c_make_struct (exp_vtables[SCM_EXPANDED_TOPLEVEL_DEFINE], 0, SCM_NUM_EXPANDED_TOPLEVEL_DEFINE_FIELDS, SCM_UNPACK (src), SCM_UNPACK (mod), SCM_UNPACK (name), SCM_UNPACK (exp))
|
||||
|
||||
#define SCM_EXPANDED_CONDITIONAL_TYPE_NAME "conditional"
|
||||
#define SCM_EXPANDED_CONDITIONAL_FIELD_NAMES \
|
||||
|
|
|
|||
|
|
@ -139,11 +139,12 @@
|
|||
(translate-literal-syntax-objects
|
||||
(make-toplevel-define
|
||||
(toplevel-define-src x)
|
||||
(toplevel-define-mod x)
|
||||
(toplevel-define-name x)
|
||||
(make-let (toplevel-define-src x)
|
||||
(list 'make-syntax)
|
||||
(list (module-gensym))
|
||||
(list (make-toplevel-ref #f 'make-syntax))
|
||||
(list (make-toplevel-ref #f #f 'make-syntax))
|
||||
(toplevel-define-exp x))))))))
|
||||
|
||||
;; Avoid gratuitous churn in psyntax-pp.scm due to the marks and labels
|
||||
|
|
|
|||
|
|
@ -45,14 +45,24 @@
|
|||
public?
|
||||
exp)))
|
||||
(make-toplevel-ref
|
||||
(lambda (src name)
|
||||
(make-struct/simple (vector-ref %expanded-vtables 7) src name)))
|
||||
(lambda (src mod name)
|
||||
(make-struct/simple (vector-ref %expanded-vtables 7) src mod name)))
|
||||
(make-toplevel-set
|
||||
(lambda (src name exp)
|
||||
(make-struct/simple (vector-ref %expanded-vtables 8) src name exp)))
|
||||
(lambda (src mod name exp)
|
||||
(make-struct/simple
|
||||
(vector-ref %expanded-vtables 8)
|
||||
src
|
||||
mod
|
||||
name
|
||||
exp)))
|
||||
(make-toplevel-define
|
||||
(lambda (src name exp)
|
||||
(make-struct/simple (vector-ref %expanded-vtables 9) src name exp)))
|
||||
(lambda (src mod name exp)
|
||||
(make-struct/simple
|
||||
(vector-ref %expanded-vtables 9)
|
||||
src
|
||||
mod
|
||||
name
|
||||
exp)))
|
||||
(make-conditional
|
||||
(lambda (src test consequent alternate)
|
||||
(make-struct/simple
|
||||
|
|
@ -143,20 +153,20 @@
|
|||
(analyze-variable
|
||||
(lambda (mod var modref-cont bare-cont)
|
||||
(if (not mod)
|
||||
(bare-cont var)
|
||||
(bare-cont #f var)
|
||||
(let ((kind (car mod)) (mod (cdr mod)))
|
||||
(let ((key kind))
|
||||
(cond ((memv key '(public)) (modref-cont mod var #t))
|
||||
((memv key '(private))
|
||||
(if (not (equal? mod (module-name (current-module))))
|
||||
(modref-cont mod var #f)
|
||||
(bare-cont var)))
|
||||
(if (equal? mod (module-name (current-module)))
|
||||
(bare-cont mod var)
|
||||
(modref-cont mod var #f)))
|
||||
((memv key '(bare)) (bare-cont var))
|
||||
((memv key '(hygiene))
|
||||
(if (and (not (equal? mod (module-name (current-module))))
|
||||
(module-variable (resolve-module mod) var))
|
||||
(modref-cont mod var #f)
|
||||
(bare-cont var)))
|
||||
(bare-cont mod var)))
|
||||
((memv key '(primitive))
|
||||
(syntax-violation #f "primitive not in operator position" var))
|
||||
(else (syntax-violation #f "bad module kind" var mod))))))))
|
||||
|
|
@ -166,7 +176,7 @@
|
|||
mod
|
||||
var
|
||||
(lambda (mod var public?) (make-module-ref source mod var public?))
|
||||
(lambda (var) (make-toplevel-ref source var)))))
|
||||
(lambda (mod var) (make-toplevel-ref source mod var)))))
|
||||
(build-global-assignment
|
||||
(lambda (source var exp mod)
|
||||
(maybe-name-value! var exp)
|
||||
|
|
@ -175,11 +185,11 @@
|
|||
var
|
||||
(lambda (mod var public?)
|
||||
(make-module-set source mod var public? exp))
|
||||
(lambda (var) (make-toplevel-set source var exp)))))
|
||||
(lambda (mod var) (make-toplevel-set source mod var exp)))))
|
||||
(build-global-definition
|
||||
(lambda (source var exp)
|
||||
(lambda (source mod var exp)
|
||||
(maybe-name-value! var exp)
|
||||
(make-toplevel-define source var exp)))
|
||||
(make-toplevel-define source (and mod (cdr mod)) var exp)))
|
||||
(build-simple-lambda
|
||||
(lambda (src req rest vars meta exp)
|
||||
(make-lambda
|
||||
|
|
@ -583,7 +593,7 @@
|
|||
(syntax-expression id))))
|
||||
(record-definition! id var)
|
||||
(list (if (eq? m 'c&e)
|
||||
(let ((x (build-global-definition s var (expand e r w mod))))
|
||||
(let ((x (build-global-definition s mod var (expand e r w mod))))
|
||||
(top-level-eval-hook x mod)
|
||||
(lambda () x))
|
||||
(call-with-values
|
||||
|
|
@ -591,9 +601,9 @@
|
|||
(lambda (type* value* mod*)
|
||||
(if (eq? type* 'macro)
|
||||
(top-level-eval-hook
|
||||
(build-global-definition s var (build-void s))
|
||||
(build-global-definition s mod var (build-void s))
|
||||
mod))
|
||||
(lambda () (build-global-definition s var (expand e r w mod)))))))))
|
||||
(lambda () (build-global-definition s mod var (expand e r w mod)))))))))
|
||||
((memv key '(define-syntax-form define-syntax-parameter-form))
|
||||
(let* ((id (wrap value w mod))
|
||||
(label (gen-label))
|
||||
|
|
@ -604,21 +614,21 @@
|
|||
(let ((key m))
|
||||
(cond ((memv key '(c))
|
||||
(cond ((memq 'compile esew)
|
||||
(let ((e (expand-install-global var type (expand e r w mod))))
|
||||
(let ((e (expand-install-global mod var type (expand e r w mod))))
|
||||
(top-level-eval-hook e mod)
|
||||
(if (memq 'load esew) (list (lambda () e)) '())))
|
||||
((memq 'load esew)
|
||||
(list (lambda ()
|
||||
(expand-install-global var type (expand e r w mod)))))
|
||||
(expand-install-global mod var type (expand e r w mod)))))
|
||||
(else '())))
|
||||
((memv key '(c&e))
|
||||
(let ((e (expand-install-global var type (expand e r w mod))))
|
||||
(let ((e (expand-install-global mod var type (expand e r w mod))))
|
||||
(top-level-eval-hook e mod)
|
||||
(list (lambda () e))))
|
||||
(else
|
||||
(if (memq 'eval esew)
|
||||
(top-level-eval-hook
|
||||
(expand-install-global var type (expand e r w mod))
|
||||
(expand-install-global mod var type (expand e r w mod))
|
||||
mod))
|
||||
'())))))
|
||||
((memv key '(begin-form))
|
||||
|
|
@ -683,9 +693,10 @@
|
|||
(let ((exps (map (lambda (x) (x)) (reverse (parse body r w s m esew mod)))))
|
||||
(if (null? exps) (build-void s) (build-sequence s exps)))))))
|
||||
(expand-install-global
|
||||
(lambda (name type e)
|
||||
(lambda (mod name type e)
|
||||
(build-global-definition
|
||||
#f
|
||||
mod
|
||||
name
|
||||
(build-primcall
|
||||
#f
|
||||
|
|
@ -976,11 +987,11 @@
|
|||
(source-wrap e w (cdr w) mod)
|
||||
x))
|
||||
(else (decorate-source x s))))))
|
||||
(let* ((t-680b775fb37a463-7b8 transformer-environment)
|
||||
(t-680b775fb37a463-7b9 (lambda (k) (k e r w s rib mod))))
|
||||
(let* ((t-680b775fb37a463-7c8 transformer-environment)
|
||||
(t-680b775fb37a463-7c9 (lambda (k) (k e r w s rib mod))))
|
||||
(with-fluid*
|
||||
t-680b775fb37a463-7b8
|
||||
t-680b775fb37a463-7b9
|
||||
t-680b775fb37a463-7c8
|
||||
t-680b775fb37a463-7c9
|
||||
(lambda ()
|
||||
(rebuild-macro-output
|
||||
(p (source-wrap e (anti-mark w) s mod))
|
||||
|
|
@ -1513,11 +1524,11 @@
|
|||
s
|
||||
mod
|
||||
get-formals
|
||||
(map (lambda (tmp-680b775fb37a463-aa9
|
||||
tmp-680b775fb37a463-aa8
|
||||
tmp-680b775fb37a463-aa7)
|
||||
(cons tmp-680b775fb37a463-aa7
|
||||
(cons tmp-680b775fb37a463-aa8 tmp-680b775fb37a463-aa9)))
|
||||
(map (lambda (tmp-680b775fb37a463-ab9
|
||||
tmp-680b775fb37a463-ab8
|
||||
tmp-680b775fb37a463-ab7)
|
||||
(cons tmp-680b775fb37a463-ab7
|
||||
(cons tmp-680b775fb37a463-ab8 tmp-680b775fb37a463-ab9)))
|
||||
e2*
|
||||
e1*
|
||||
args*)))
|
||||
|
|
@ -1815,11 +1826,11 @@
|
|||
(apply (lambda (args e1 e2)
|
||||
(build-it
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-c76
|
||||
tmp-680b775fb37a463-c75
|
||||
tmp-680b775fb37a463-c74)
|
||||
(cons tmp-680b775fb37a463-c74
|
||||
(cons tmp-680b775fb37a463-c75 tmp-680b775fb37a463-c76)))
|
||||
(map (lambda (tmp-680b775fb37a463-c86
|
||||
tmp-680b775fb37a463-c85
|
||||
tmp-680b775fb37a463-c84)
|
||||
(cons tmp-680b775fb37a463-c84
|
||||
(cons tmp-680b775fb37a463-c85 tmp-680b775fb37a463-c86)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -1831,11 +1842,11 @@
|
|||
(apply (lambda (docstring args e1 e2)
|
||||
(build-it
|
||||
(list (cons 'documentation (syntax->datum docstring)))
|
||||
(map (lambda (tmp-680b775fb37a463-c8c
|
||||
tmp-680b775fb37a463-c8b
|
||||
tmp-680b775fb37a463-c8a)
|
||||
(cons tmp-680b775fb37a463-c8a
|
||||
(cons tmp-680b775fb37a463-c8b tmp-680b775fb37a463-c8c)))
|
||||
(map (lambda (tmp-680b775fb37a463-c9c
|
||||
tmp-680b775fb37a463-c9b
|
||||
tmp-680b775fb37a463-c9a)
|
||||
(cons tmp-680b775fb37a463-c9a
|
||||
(cons tmp-680b775fb37a463-c9b tmp-680b775fb37a463-c9c)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -1858,11 +1869,11 @@
|
|||
(apply (lambda (args e1 e2)
|
||||
(build-it
|
||||
'()
|
||||
(map (lambda (tmp-680b775fb37a463-cac
|
||||
tmp-680b775fb37a463-cab
|
||||
tmp-680b775fb37a463-caa)
|
||||
(cons tmp-680b775fb37a463-caa
|
||||
(cons tmp-680b775fb37a463-cab tmp-680b775fb37a463-cac)))
|
||||
(map (lambda (tmp-680b775fb37a463-cbc
|
||||
tmp-680b775fb37a463-cbb
|
||||
tmp-680b775fb37a463-cba)
|
||||
(cons tmp-680b775fb37a463-cba
|
||||
(cons tmp-680b775fb37a463-cbb tmp-680b775fb37a463-cbc)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -1874,11 +1885,11 @@
|
|||
(apply (lambda (docstring args e1 e2)
|
||||
(build-it
|
||||
(list (cons 'documentation (syntax->datum docstring)))
|
||||
(map (lambda (tmp-680b775fb37a463-cc2
|
||||
tmp-680b775fb37a463-cc1
|
||||
tmp-680b775fb37a463-cc0)
|
||||
(cons tmp-680b775fb37a463-cc0
|
||||
(cons tmp-680b775fb37a463-cc1 tmp-680b775fb37a463-cc2)))
|
||||
(map (lambda (tmp-680b775fb37a463-cd2
|
||||
tmp-680b775fb37a463-cd1
|
||||
tmp-680b775fb37a463-cd0)
|
||||
(cons tmp-680b775fb37a463-cd0
|
||||
(cons tmp-680b775fb37a463-cd1 tmp-680b775fb37a463-cd2)))
|
||||
e2
|
||||
e1
|
||||
args)))
|
||||
|
|
@ -2803,9 +2814,9 @@
|
|||
k
|
||||
(list docstring)
|
||||
(map (lambda (tmp-680b775fb37a463
|
||||
tmp-680b775fb37a463-112f
|
||||
tmp-680b775fb37a463-112e)
|
||||
(list (cons tmp-680b775fb37a463-112e tmp-680b775fb37a463-112f)
|
||||
tmp-680b775fb37a463-113f
|
||||
tmp-680b775fb37a463-113e)
|
||||
(list (cons tmp-680b775fb37a463-113e tmp-680b775fb37a463-113f)
|
||||
tmp-680b775fb37a463))
|
||||
template
|
||||
pattern
|
||||
|
|
@ -2989,8 +3000,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasilist*
|
||||
(map (lambda (tmp-680b775fb37a463-11d3)
|
||||
(list "value" tmp-680b775fb37a463-11d3))
|
||||
(map (lambda (tmp-680b775fb37a463-11e3)
|
||||
(list "value" tmp-680b775fb37a463-11e3))
|
||||
p)
|
||||
(quasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3013,8 +3024,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasiappend
|
||||
(map (lambda (tmp-680b775fb37a463-11d8)
|
||||
(list "value" tmp-680b775fb37a463-11d8))
|
||||
(map (lambda (tmp-680b775fb37a463-11e8)
|
||||
(list "value" tmp-680b775fb37a463-11e8))
|
||||
p)
|
||||
(quasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3048,8 +3059,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasilist*
|
||||
(map (lambda (tmp-680b775fb37a463-11ee)
|
||||
(list "value" tmp-680b775fb37a463-11ee))
|
||||
(map (lambda (tmp-680b775fb37a463-11fe)
|
||||
(list "value" tmp-680b775fb37a463-11fe))
|
||||
p)
|
||||
(vquasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3068,8 +3079,8 @@
|
|||
(apply (lambda (p)
|
||||
(if (= lev 0)
|
||||
(quasiappend
|
||||
(map (lambda (tmp-680b775fb37a463-11f3)
|
||||
(list "value" tmp-680b775fb37a463-11f3))
|
||||
(map (lambda (tmp-680b775fb37a463)
|
||||
(list "value" tmp-680b775fb37a463))
|
||||
p)
|
||||
(vquasi q lev))
|
||||
(quasicons
|
||||
|
|
@ -3159,8 +3170,8 @@
|
|||
(let ((tmp-1 ls))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463-123c)
|
||||
(cons "vector" t-680b775fb37a463-123c))
|
||||
(apply (lambda (t-680b775fb37a463-124c)
|
||||
(cons "vector" t-680b775fb37a463-124c))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3213,9 +3224,9 @@
|
|||
(let ((tmp-1 (list (emit (car x*)) (f (cdr x*)))))
|
||||
(let ((tmp ($sc-dispatch tmp-1 '(any any))))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463-127a t-680b775fb37a463)
|
||||
(apply (lambda (t-680b775fb37a463-128a t-680b775fb37a463)
|
||||
(list (make-syntax 'cons '((top)) '(hygiene guile))
|
||||
t-680b775fb37a463-127a
|
||||
t-680b775fb37a463-128a
|
||||
t-680b775fb37a463))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
|
|
@ -3244,9 +3255,9 @@
|
|||
(let ((tmp-1 (map emit x)))
|
||||
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
|
||||
(if tmp
|
||||
(apply (lambda (t-680b775fb37a463)
|
||||
(apply (lambda (t-680b775fb37a463-12a2)
|
||||
(cons (make-syntax 'vector '((top)) '(hygiene guile))
|
||||
t-680b775fb37a463))
|
||||
t-680b775fb37a463-12a2))
|
||||
tmp)
|
||||
(syntax-violation
|
||||
#f
|
||||
|
|
@ -3257,9 +3268,9 @@
|
|||
(if tmp-1
|
||||
(apply (lambda (x)
|
||||
(let ((tmp (emit x)))
|
||||
(let ((t-680b775fb37a463-129e tmp))
|
||||
(let ((t-680b775fb37a463-12ae tmp))
|
||||
(list (make-syntax 'list->vector '((top)) '(hygiene guile))
|
||||
t-680b775fb37a463-129e))))
|
||||
t-680b775fb37a463-12ae))))
|
||||
tmp-1)
|
||||
(let ((tmp-1 ($sc-dispatch tmp '(#(atom "value") any))))
|
||||
(if tmp-1
|
||||
|
|
|
|||
|
|
@ -329,19 +329,19 @@
|
|||
|
||||
(define (analyze-variable mod var modref-cont bare-cont)
|
||||
(if (not mod)
|
||||
(bare-cont var)
|
||||
(bare-cont #f var)
|
||||
(let ((kind (car mod))
|
||||
(mod (cdr mod)))
|
||||
(case kind
|
||||
((public) (modref-cont mod var #t))
|
||||
((private) (if (not (equal? mod (module-name (current-module))))
|
||||
(modref-cont mod var #f)
|
||||
(bare-cont var)))
|
||||
((private) (if (equal? mod (module-name (current-module)))
|
||||
(bare-cont mod var)
|
||||
(modref-cont mod var #f)))
|
||||
((bare) (bare-cont var))
|
||||
((hygiene) (if (and (not (equal? mod (module-name (current-module))))
|
||||
(module-variable (resolve-module mod) var))
|
||||
(modref-cont mod var #f)
|
||||
(bare-cont var)))
|
||||
(bare-cont mod var)))
|
||||
((primitive)
|
||||
(syntax-violation #f "primitive not in operator position" var))
|
||||
(else (syntax-violation #f "bad module kind" var mod))))))
|
||||
|
|
@ -352,8 +352,8 @@
|
|||
mod var
|
||||
(lambda (mod var public?)
|
||||
(make-module-ref source mod var public?))
|
||||
(lambda (var)
|
||||
(make-toplevel-ref source var)))))
|
||||
(lambda (mod var)
|
||||
(make-toplevel-ref source mod var)))))
|
||||
|
||||
(define build-global-assignment
|
||||
(lambda (source var exp mod)
|
||||
|
|
@ -362,13 +362,13 @@
|
|||
mod var
|
||||
(lambda (mod var public?)
|
||||
(make-module-set source mod var public? exp))
|
||||
(lambda (var)
|
||||
(make-toplevel-set source var exp)))))
|
||||
(lambda (mod var)
|
||||
(make-toplevel-set source mod var exp)))))
|
||||
|
||||
(define build-global-definition
|
||||
(lambda (source var exp)
|
||||
(lambda (source mod var exp)
|
||||
(maybe-name-value! var exp)
|
||||
(make-toplevel-define source var exp)))
|
||||
(make-toplevel-define source (and mod (cdr mod)) var exp)))
|
||||
|
||||
(define build-simple-lambda
|
||||
(lambda (src req rest vars meta exp)
|
||||
|
|
@ -1142,7 +1142,7 @@
|
|||
(record-definition! id var)
|
||||
(list
|
||||
(if (eq? m 'c&e)
|
||||
(let ((x (build-global-definition s var (expand e r w mod))))
|
||||
(let ((x (build-global-definition s mod var (expand e r w mod))))
|
||||
(top-level-eval-hook x mod)
|
||||
(lambda () x))
|
||||
(call-with-values
|
||||
|
|
@ -1152,10 +1152,10 @@
|
|||
;; macro, then immediately discard that binding.
|
||||
(if (eq? type* 'macro)
|
||||
(top-level-eval-hook (build-global-definition
|
||||
s var (build-void s))
|
||||
s mod var (build-void s))
|
||||
mod))
|
||||
(lambda ()
|
||||
(build-global-definition s var (expand e r w mod)))))))))
|
||||
(build-global-definition s mod var (expand e r w mod)))))))))
|
||||
((define-syntax-form define-syntax-parameter-form)
|
||||
(let* ((id (wrap value w mod))
|
||||
(label (gen-label))
|
||||
|
|
@ -1167,23 +1167,23 @@
|
|||
((c)
|
||||
(cond
|
||||
((memq 'compile esew)
|
||||
(let ((e (expand-install-global var type (expand e r w mod))))
|
||||
(let ((e (expand-install-global mod var type (expand e r w mod))))
|
||||
(top-level-eval-hook e mod)
|
||||
(if (memq 'load esew)
|
||||
(list (lambda () e))
|
||||
'())))
|
||||
((memq 'load esew)
|
||||
(list (lambda ()
|
||||
(expand-install-global var type (expand e r w mod)))))
|
||||
(expand-install-global mod var type (expand e r w mod)))))
|
||||
(else '())))
|
||||
((c&e)
|
||||
(let ((e (expand-install-global var type (expand e r w mod))))
|
||||
(let ((e (expand-install-global mod var type (expand e r w mod))))
|
||||
(top-level-eval-hook e mod)
|
||||
(list (lambda () e))))
|
||||
(else
|
||||
(if (memq 'eval esew)
|
||||
(top-level-eval-hook
|
||||
(expand-install-global var type (expand e r w mod))
|
||||
(expand-install-global mod var type (expand e r w mod))
|
||||
mod))
|
||||
'()))))
|
||||
((begin-form)
|
||||
|
|
@ -1244,9 +1244,10 @@
|
|||
(build-sequence s exps))))))
|
||||
|
||||
(define expand-install-global
|
||||
(lambda (name type e)
|
||||
(lambda (mod name type e)
|
||||
(build-global-definition
|
||||
no-source
|
||||
mod
|
||||
name
|
||||
(build-primcall
|
||||
no-source
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;;; Copyright (C) 2009-2014, 2017-2018 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2009-2014, 2017-2019 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -30,9 +30,9 @@
|
|||
<lexical-set> lexical-set? make-lexical-set lexical-set-src lexical-set-name lexical-set-gensym lexical-set-exp
|
||||
<module-ref> module-ref? make-module-ref module-ref-src module-ref-mod module-ref-name module-ref-public?
|
||||
<module-set> module-set? make-module-set module-set-src module-set-mod module-set-name module-set-public? module-set-exp
|
||||
<toplevel-ref> toplevel-ref? make-toplevel-ref toplevel-ref-src toplevel-ref-name
|
||||
<toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp
|
||||
<toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp
|
||||
<toplevel-ref> toplevel-ref? make-toplevel-ref toplevel-ref-src toplevel-ref-mod toplevel-ref-name
|
||||
<toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-mod toplevel-set-name toplevel-set-exp
|
||||
<toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-mod toplevel-define-name toplevel-define-exp
|
||||
<conditional> conditional? make-conditional conditional-src conditional-test conditional-consequent conditional-alternate
|
||||
<call> call? make-call call-src call-proc call-args
|
||||
<primcall> primcall? make-primcall primcall-src primcall-name primcall-args
|
||||
|
|
@ -117,9 +117,9 @@
|
|||
;; (<lexical-set> name gensym exp)
|
||||
;; (<module-ref> mod name public?)
|
||||
;; (<module-set> mod name public? exp)
|
||||
;; (<toplevel-ref> name)
|
||||
;; (<toplevel-set> name exp)
|
||||
;; (<toplevel-define> name exp)
|
||||
;; (<toplevel-ref> mod name)
|
||||
;; (<toplevel-set> mod name exp)
|
||||
;; (<toplevel-define> mod name exp)
|
||||
;; (<conditional> test consequent alternate)
|
||||
;; (<call> proc args)
|
||||
;; (<primcall> name args)
|
||||
|
|
@ -197,13 +197,13 @@
|
|||
(make-module-set loc mod name #f (retrans exp)))
|
||||
|
||||
(('toplevel (and name (? symbol?)))
|
||||
(make-toplevel-ref loc name))
|
||||
(make-toplevel-ref loc #f name))
|
||||
|
||||
(('set! ('toplevel (and name (? symbol?))) exp)
|
||||
(make-toplevel-set loc name (retrans exp)))
|
||||
(make-toplevel-set loc #f name (retrans exp)))
|
||||
|
||||
(('define (and name (? symbol?)) exp)
|
||||
(make-toplevel-define loc name (retrans exp)))
|
||||
(make-toplevel-define loc #f name (retrans exp)))
|
||||
|
||||
(('lambda meta body)
|
||||
(make-lambda loc meta (retrans body)))
|
||||
|
|
@ -286,13 +286,13 @@
|
|||
(($ <module-set> src mod name public? exp)
|
||||
`(set! (,(if public? '@ '@@) ,mod ,name) ,(unparse-tree-il exp)))
|
||||
|
||||
(($ <toplevel-ref> src name)
|
||||
(($ <toplevel-ref> src mod name)
|
||||
`(toplevel ,name))
|
||||
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
`(set! (toplevel ,name) ,(unparse-tree-il exp)))
|
||||
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
`(define ,name ,(unparse-tree-il exp)))
|
||||
|
||||
(($ <lambda> src meta body)
|
||||
|
|
@ -356,9 +356,9 @@
|
|||
(foldts exp seed ...))
|
||||
(($ <module-set> src mod name public? exp)
|
||||
(foldts exp seed ...))
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(foldts exp seed ...))
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
(foldts exp seed ...))
|
||||
(($ <conditional> src test consequent alternate)
|
||||
(let*-values (((seed ...) (foldts test seed ...))
|
||||
|
|
@ -449,17 +449,17 @@ This is an implementation of `foldts' as described by Andy Wingo in
|
|||
x
|
||||
(make-module-set src mod name public? exp*))))
|
||||
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(let ((exp* (lp exp)))
|
||||
(if (eq? exp exp*)
|
||||
x
|
||||
(make-toplevel-set src name exp*))))
|
||||
(make-toplevel-set src mod name exp*))))
|
||||
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
(let ((exp* (lp exp)))
|
||||
(if (eq? exp exp*)
|
||||
x
|
||||
(make-toplevel-define src name exp*))))
|
||||
(make-toplevel-define src mod name exp*))))
|
||||
|
||||
(($ <conditional> src test consequent alternate)
|
||||
(let ((test* (lp test))
|
||||
|
|
|
|||
|
|
@ -873,7 +873,7 @@ given `tree-il' element."
|
|||
(match proc
|
||||
(($ <module-ref> _ '(oop goops) 'toplevel-define! #f)
|
||||
(toplevel-define-arg args))
|
||||
(($ <toplevel-ref> _ 'toplevel-define!)
|
||||
(($ <toplevel-ref> _ _ 'toplevel-define!)
|
||||
;; This may be the result of expanding one of the GOOPS macros within
|
||||
;; `oop/goops.scm'.
|
||||
(and (eq? env (resolve-module '(oop goops)))
|
||||
|
|
@ -972,11 +972,11 @@ given `tree-il' element."
|
|||
(($ <primcall> _ 'make-syntax-transformer) #t)
|
||||
(_ #f)))
|
||||
(match x
|
||||
(($ <toplevel-ref> src name)
|
||||
(($ <toplevel-ref> src mod name)
|
||||
(add-use name (nearest-loc src)))
|
||||
(($ <toplevel-set> src name)
|
||||
(($ <toplevel-set> src mod name)
|
||||
(add-use name (nearest-loc src)))
|
||||
(($ <toplevel-define> src name (? macro?))
|
||||
(($ <toplevel-define> src mod name (? macro?))
|
||||
(add-def name (nearest-loc src)))
|
||||
(_ info)))
|
||||
|
||||
|
|
@ -1421,10 +1421,10 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
|
|||
(cut eq? <> special-name))
|
||||
|
||||
(match exp
|
||||
(($ <toplevel-ref> _ (? special?))
|
||||
(($ <toplevel-ref> _ _ (? special?))
|
||||
;; Allow top-levels like: (define _ (cut gettext <> "my-domain")).
|
||||
#t)
|
||||
(($ <toplevel-ref> _ name)
|
||||
(($ <toplevel-ref> _ _ name)
|
||||
(let ((var (module-variable env name)))
|
||||
(and var (variable-bound? var)
|
||||
(eq? (variable-ref var) proc))))
|
||||
|
|
@ -1464,7 +1464,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
|
|||
(define format-analysis
|
||||
;; Report arity mismatches in the given tree.
|
||||
(make-tree-analysis
|
||||
(lambda (x _ env locs)
|
||||
(lambda (x res env locs)
|
||||
;; Down into X.
|
||||
(define (check-format-args args loc)
|
||||
(pmatch args
|
||||
|
|
@ -1539,7 +1539,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
|
|||
(false-if-exception (module-ref env name))))
|
||||
|
||||
(match x
|
||||
(($ <call> src ($ <toplevel-ref> _ name) args)
|
||||
(($ <call> src ($ <toplevel-ref> _ _ name) args)
|
||||
(let ((proc (resolve-toplevel name)))
|
||||
(if (or (and (eq? proc (@ (guile) simple-format))
|
||||
(check-simple-format-args args
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Continuation-passing style (CPS) intermediate language (IL)
|
||||
|
||||
;; Copyright (C) 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2013-2015,2017-2019 Free Software Foundation, Inc.
|
||||
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -1849,7 +1849,7 @@
|
|||
($continue k src
|
||||
($primcall 'scm-set!/immediate '(box . 1) (box val))))))))))
|
||||
|
||||
(($ <toplevel-ref> src name)
|
||||
(($ <toplevel-ref> src mod name)
|
||||
(toplevel-box
|
||||
cps src name #t
|
||||
(lambda (cps box)
|
||||
|
|
@ -1859,7 +1859,7 @@
|
|||
($continue k src
|
||||
($primcall 'scm-ref/immediate '(box . 1) (box))))))))
|
||||
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(convert-arg cps exp
|
||||
(lambda (cps val)
|
||||
(toplevel-box
|
||||
|
|
@ -1871,7 +1871,7 @@
|
|||
($continue k src
|
||||
($primcall 'scm-set!/immediate '(box . 1) (box val))))))))))
|
||||
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src modname name exp)
|
||||
(convert-arg cps exp
|
||||
(lambda (cps val)
|
||||
(with-cps cps
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Tree-IL verifier
|
||||
|
||||
;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2011, 2013, 2019 Free Software Foundation, Inc.
|
||||
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -170,8 +170,10 @@
|
|||
(visit body env))))
|
||||
(($ <const> src val) #t)
|
||||
(($ <void> src) #t)
|
||||
(($ <toplevel-ref> src name)
|
||||
(($ <toplevel-ref> src mod name)
|
||||
(cond
|
||||
((and mod (not (and (list? mod) (and-map symbol? mod))))
|
||||
(error "module name should be #f or list of symbols" mod))
|
||||
((not (symbol? name))
|
||||
(error "name should be a symbol" name))))
|
||||
(($ <module-ref> src mod name public?)
|
||||
|
|
@ -184,14 +186,18 @@
|
|||
(cond
|
||||
((not (symbol? name))
|
||||
(error "name should be symbol" exp))))
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(cond
|
||||
((and mod (not (and (list? mod) (and-map symbol? mod))))
|
||||
(error "module name should be #f or list of symbols" mod))
|
||||
((not (symbol? name))
|
||||
(error "name should be a symbol" name))
|
||||
(else
|
||||
(visit exp env))))
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
(cond
|
||||
((and mod (not (and (list? mod) (and-map symbol? mod))))
|
||||
(error "module name should be #f or list of symbols" mod))
|
||||
((not (symbol? name))
|
||||
(error "name should be a symbol" name))
|
||||
(else
|
||||
|
|
|
|||
|
|
@ -294,10 +294,10 @@ of an expression."
|
|||
(logior (cause &toplevel)
|
||||
(cause &type-check)
|
||||
(compute-effects exp)))
|
||||
(($ <toplevel-define> _ name exp)
|
||||
(($ <toplevel-define> _ _ name exp)
|
||||
(logior (cause &toplevel)
|
||||
(compute-effects exp)))
|
||||
(($ <toplevel-set> _ name exp)
|
||||
(($ <toplevel-set> _ _ name exp)
|
||||
(logior (cause &toplevel)
|
||||
(compute-effects exp)))
|
||||
(($ <primitive-ref>)
|
||||
|
|
|
|||
|
|
@ -87,9 +87,9 @@
|
|||
(adjoin gensym (recurse exp)))
|
||||
(($ <module-set> src mod name public? exp)
|
||||
(recurse exp))
|
||||
(($ <toplevel-set> src name exp)
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(recurse exp))
|
||||
(($ <toplevel-define> src name exp)
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
(recurse exp))
|
||||
(($ <conditional> src test consequent alternate)
|
||||
(union (recurse test)
|
||||
|
|
|
|||
|
|
@ -387,7 +387,7 @@ top-level bindings from ENV and return the resulting expression."
|
|||
(let ()
|
||||
(define (env-folder x env)
|
||||
(match x
|
||||
(($ <toplevel-define> _ name)
|
||||
(($ <toplevel-define> _ _ name)
|
||||
(vhash-consq name #t env))
|
||||
(($ <seq> _ head tail)
|
||||
(env-folder tail (env-folder head env)))
|
||||
|
|
@ -1020,7 +1020,7 @@ top-level bindings from ENV and return the resulting expression."
|
|||
(else #f))))
|
||||
(_ #f))
|
||||
(make-let-values lv-src producer (for-tail consumer)))))
|
||||
(($ <toplevel-ref> src (? effect-free-primitive? name))
|
||||
(($ <toplevel-ref> src mod (? effect-free-primitive? name))
|
||||
exp)
|
||||
(($ <toplevel-ref>)
|
||||
;; todo: open private local bindings.
|
||||
|
|
@ -1038,10 +1038,10 @@ top-level bindings from ENV and return the resulting expression."
|
|||
exp)
|
||||
(($ <module-set> src mod name public? exp)
|
||||
(make-module-set src mod name public? (for-value exp)))
|
||||
(($ <toplevel-define> src name exp)
|
||||
(make-toplevel-define src name (for-value exp)))
|
||||
(($ <toplevel-set> src name exp)
|
||||
(make-toplevel-set src name (for-value exp)))
|
||||
(($ <toplevel-define> src mod name exp)
|
||||
(make-toplevel-define src mod name (for-value exp)))
|
||||
(($ <toplevel-set> src mod name exp)
|
||||
(make-toplevel-set src mod name (for-value exp)))
|
||||
(($ <primitive-ref>)
|
||||
(case ctx
|
||||
((effect) (make-void #f))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
|
||||
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
|
||||
;;;;
|
||||
;;;; Copyright (C) 2009-2014, 2018 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2009-2014,2018-2019 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -188,11 +188,11 @@
|
|||
x))
|
||||
(and (= result 12)
|
||||
(equal? (map strip-source (list-head (reverse ups) 3))
|
||||
(list (make-toplevel-ref #f '+)
|
||||
(list (make-toplevel-ref #f #f '+)
|
||||
(make-lexical-ref #f 'x 'x1)
|
||||
(make-lexical-ref #f 'y 'y1)))
|
||||
(equal? (map strip-source (reverse (list-head downs 3)))
|
||||
(list (make-toplevel-ref #f '+)
|
||||
(list (make-toplevel-ref #f #f '+)
|
||||
(make-lexical-ref #f 'x 'x1)
|
||||
(make-lexical-ref #f 'y 'y1)))))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue