[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 14/16: Compile "define!" via intrinsic
From: |
Andy Wingo |
Subject: |
[Guile-commits] 14/16: Compile "define!" via intrinsic |
Date: |
Mon, 14 May 2018 10:48:36 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit ceffb5e990efa6d8f9a2eb6cc128ebbddf61a819
Author: Andy Wingo <address@hidden>
Date: Mon May 14 15:15:22 2018 +0200
Compile "define!" via intrinsic
* libguile/intrinsics.c (scm_bootstrap_intrinsics):
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add new define!
intrinsic.
* module/language/cps/compile-bytecode.scm (compile-function): Adapt
compilation for define! to take two arguments.
* module/language/cps/effects-analysis.scm (current-module): Update
define! for two arguments.
* module/language/tree-il/compile-cps.scm (convert): When reifying
"define", grab the current module.
* module/system/vm/assembler.scm (define!): Define assembler as
intrinsic.
---
libguile/intrinsics.c | 1 +
libguile/intrinsics.h | 1 +
module/language/cps/compile-bytecode.scm | 5 +++--
module/language/cps/effects-analysis.scm | 2 +-
module/language/tree-il/compile-cps.scm | 8 ++++++--
module/system/vm/assembler.scm | 3 ++-
6 files changed, 14 insertions(+), 6 deletions(-)
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 64f8d7f..0655c2a 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -300,6 +300,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
scm_vm_intrinsics.resolve_module = resolve_module;
scm_vm_intrinsics.lookup = lookup;
+ scm_vm_intrinsics.define_x = scm_module_ensure_local_variable;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 9d5bc7d..7b67f80 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -84,6 +84,7 @@ typedef enum scm_compare
(*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
M(scm_from_scm_uimm, resolve_module, "resolve-module", RESOLVE_MODULE) \
M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
+ M(scm_from_scm_scm, define_x, "define!", DEFINE_X) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index fddf2fd..91ae19c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -143,8 +143,9 @@
(emit-current-module asm (from-sp dst)))
(($ $primcall 'current-thread)
(emit-current-thread asm (from-sp dst)))
- (($ $primcall 'define! #f (sym))
- (emit-define! asm (from-sp dst) (from-sp (slot sym))))
+ (($ $primcall 'define! #f (mod sym))
+ (emit-define! asm (from-sp dst)
+ (from-sp (slot mod)) (from-sp (slot sym))))
(($ $primcall 'resolve (bound?) (name))
(emit-resolve asm (from-sp dst) bound? (from-sp (slot name))))
(($ $primcall 'allocate-words annotation (nfields))
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 1e14848..9bc2ffe 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -463,7 +463,7 @@ the LABELS that are clobbered by the effects of LABEL."
((lookup mod name) (&read-object &module) &type-check)
((cached-toplevel-box) &type-check)
((cached-module-box) &type-check)
- ((define! name) (&read-object &module)))
+ ((define! mod name) (&read-object &module)))
;; Cache cells.
(define-primitive-effects
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 4574c8b..23eb5ea 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1851,13 +1851,17 @@
(lambda (cps val)
(with-cps cps
(let$ k (adapt-arity k src 0))
- (letv box)
+ (letv box mod)
(letk kset ($kargs ('box) (box)
($continue k src
($primcall 'scm-set!/immediate '(box . 1) (box
val)))))
($ (with-cps-constants ((name name))
+ (letk kmod
+ ($kargs ('mod) (mod)
+ ($continue kset src
+ ($primcall 'define! #f (mod name)))))
(build-term
- ($continue kset src ($primcall 'define! #f (name))))))))))
+ ($continue kmod src ($primcall 'current-module #f ())))))))))
(($ <call> src proc args)
(convert-args cps (cons proc args)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index e8e767d..650156d 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -226,6 +226,7 @@
emit-rsh/immediate
emit-resolve-module
emit-lookup
+ emit-define!
emit-cache-ref
emit-cache-set!
@@ -251,7 +252,6 @@
emit-load-label
emit-current-module
emit-resolve
- emit-define!
emit-prompt
emit-current-thread
emit-fadd
@@ -1375,6 +1375,7 @@ returned instead."
(define-scm<-scm-uimm-intrinsic rsh/immediate)
(define-scm<-scm-bool-intrinsic resolve-module)
(define-scm<-scm-scm-intrinsic lookup)
+(define-scm<-scm-scm-intrinsic define!)
(define-macro-assembler (begin-program asm label properties)
(emit-label asm label)
- [Guile-commits] 07/16: Mark call-scm<-scm-u64 as defining a result, (continued)
- [Guile-commits] 07/16: Mark call-scm<-scm-u64 as defining a result, Andy Wingo, 2018/05/14
- [Guile-commits] 12/16: Instruction explosion for cache-current-module, cached-toplevel-box, Andy Wingo, 2018/05/14
- [Guile-commits] 10/16: Add cache-ref, cache-set! macro-instructions, Andy Wingo, 2018/05/14
- [Guile-commits] 03/16: VM calls out to heap-numbers-equal? through intrinsics, Andy Wingo, 2018/05/14
- [Guile-commits] 15/16: Use intrinsics for top-level refs outside captured scopes, Andy Wingo, 2018/05/14
- [Guile-commits] 16/16: Remove implementations of now-unused toplevel-box et al instructions, Andy Wingo, 2018/05/14
- [Guile-commits] 13/16: Remove backend support for cached-module-box et al., Andy Wingo, 2018/05/14
- [Guile-commits] 11/16: Instruction explosion for cached-module-box, Andy Wingo, 2018/05/14
- [Guile-commits] 09/16: Add intrinsics for module operations, Andy Wingo, 2018/05/14
- [Guile-commits] 01/16: lsh, rsh etc are intrinsics, Andy Wingo, 2018/05/14
- [Guile-commits] 14/16: Compile "define!" via intrinsic,
Andy Wingo <=