diff options
| author | Andy Wingo <wingo@pobox.com> | 2021-04-02 10:07:07 +0200 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2021-05-11 21:39:07 +0200 |
| commit | 809b1651289b330fbcc30d539e1b3c5c20bc83af (patch) | |
| tree | 4f7bdaf7ea8fa20daeaaeb64b3599222ad6c13a5 /module/language | |
| parent | afd268ac1d3f3b4897adc6c189366bf57751e907 (diff) | |
| download | guile-809b1651289b330fbcc30d539e1b3c5c20bc83af.tar.gz | |
Letrectify links module defs with uses
* module/language/tree-il/letrectify.scm (letrectify): Inline "let"
bindings inside residualized "letrec*" forms, to allow the dominator
relationship to be reflected in the scope tree. Also, detect
"define-module*" invocations, and add these to the mod-vars set, so that
residualized "module-ensure-local-variable!" primcalls can clearly
denote their module without having to use "current-module".
Diffstat (limited to 'module/language')
| -rw-r--r-- | module/language/tree-il/letrectify.scm | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/module/language/tree-il/letrectify.scm b/module/language/tree-il/letrectify.scm index c27e75e60..60d057ffd 100644 --- a/module/language/tree-il/letrectify.scm +++ b/module/language/tree-il/letrectify.scm @@ -1,6 +1,6 @@ ;;; transformation of top-level bindings into letrec* -;; Copyright (C) 2019-2020 Free Software Foundation, Inc. +;; Copyright (C) 2019-2021 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 @@ -252,6 +252,24 @@ (add-statement src init (make-void src)))) mod-vars))))))) + (($ <let> src names vars vals body) + (let lp ((names names) (vars vars) (vals vals) (mod-vars mod-vars)) + (match (vector names vars vals) + (#(() () ()) + (values (visit-expr body) mod-vars)) + (#((name . names) (var . vars) (val . vals)) + (let* ((val (visit-expr val)) + (mod-vars + (match val + (($ <call> _ + ($ <module-ref> _ '(guile) 'define-module* #f) + (($ <const> _ mod) . args)) + (acons mod var mod-vars)) + (_ mod-vars)))) + (let-values (((exp mod-vars) (lp names vars vals mod-vars))) + (values (add-binding name var val exp) + mod-vars))))))) + (($ <seq> src head tail) (let*-values (((head mod-vars) (visit-top-level head mod-vars)) ((tail mod-vars) (visit-top-level tail mod-vars))) |