mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

cache-current-module, etc use immediate primcall parameters

Browse source 
* module/language/bytecode.scm (*macro-instruction-arities*):
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/effects-analysis.scm (current-module):
* module/language/cps/primitives.scm (*macro-instruction-arities*):
* module/language/cps/prune-top-level-scopes.scm (compute-used-scopes):
  (prune-top-level-scopes):
* module/language/cps/reify-primitives.scm (module-box):
* module/language/cps/slot-allocation.scm (compute-needs-slot):
* module/language/tree-il/compile-cps.scm (toplevel-box):
  (module-box, capture-toplevel-scope): Move the primcalls that deal
  with top-level references to use immediate parameters.
This commit is contained in:
Andy Wingo 2017-11-01 13:47:32 +01:00
parent c54c151eb6
commit 4fb538e90e
8 changed files with 48 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/language/tree-il/compile-cps.scm
View file

@ -86,47 +86,42 @@
scope-id))
(define (toplevel-box cps src name bound? val-proc)
(define (lookup cps name bound? k)
(define (lookup cps k)
(match (current-topbox-scope)
(#f
(with-cps cps
(build-term ($continue k src
($primcall 'resolve #f (name bound?))))))
(scope-id
;; FIXME: Resolve should take name as immediate.
($ (with-cps-constants ((name name))
(build-term ($continue k src
($primcall 'resolve (list bound?) (name))))))))
(scope
(with-cps cps
($ (with-cps-constants ((scope scope-id))
(build-term
($continue k src
($primcall 'cached-toplevel-box #f (scope name bound?))))))))))
(build-term
($continue k src
($primcall 'cached-toplevel-box (list scope name bound?)
())))))))
(with-cps cps
(letv box)
(let$ body (val-proc box))
(letk kbox ($kargs ('box) (box) ,body))
($ (with-cps-constants ((name name)
(bound? bound?))
($ (lookup name bound? kbox))))))
($ (lookup kbox))))
(define (module-box cps src module name public? bound? val-proc)
(with-cps cps
(letv box)
(let$ body (val-proc box))
(letk kbox ($kargs ('box) (box) ,body))
($ (with-cps-constants ((module module)
(name name)
(public? public?)
(bound? bound?))
(build-term ($continue kbox src
($primcall 'cached-module-box #f
(module name public? bound?))))))))
(build-term ($continue kbox src
($primcall 'cached-module-box
(list module name public? bound?) ())))))
(define (capture-toplevel-scope cps src scope-id k)
(with-cps cps
(letv module)
(let$ body (with-cps-constants ((scope scope-id))
(build-term
($continue k src
($primcall 'cache-current-module! #f (module scope))))))
(letk kmodule ($kargs ('module) (module) ,body))
(letk kmodule
($kargs ('module) (module)
($continue k src
($primcall 'cache-current-module! (list scope-id) (module)))))
(build-term ($continue kmodule src
($primcall 'current-module #f ())))))