[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Delay loading CPS unless CPS compiler used
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Delay loading CPS unless CPS compiler used |
Date: |
Tue, 12 May 2020 04:03:16 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit cb8cabe85f535542ac4fcb165d89722500e42653
Author: Andy Wingo <address@hidden>
AuthorDate: Mon May 11 22:42:50 2020 +0200
Delay loading CPS unless CPS compiler used
* module/language/tree-il/spec.scm: Remove #:compilers declaration;
instead rely on choose-compiler.
(choose-compiler): Load compilers on demand.
* module/system/base/compile.scm (find-language-joint): Use next-pass
instead of lookup-compilation-order, to avoid loading unused
compilers.
(read-and-compile): Adapt to find-language-joint change.
(compute-compiler): Export.
* module/scripts/compile.scm (compile): Use compute-compiler to load
compiler modules.
---
module/language/tree-il/spec.scm | 12 +++++-------
module/scripts/compile.scm | 16 ++++++++--------
module/system/base/compile.scm | 25 ++++++++++++-------------
3 files changed, 25 insertions(+), 28 deletions(-)
diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm
index 441ff7e..169f5a0 100644
--- a/module/language/tree-il/spec.scm
+++ b/module/language/tree-il/spec.scm
@@ -1,6 +1,6 @@
;;; Tree Intermediate Language
-;; Copyright (C) 2009, 2010, 2011, 2013, 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2011,2013,2015,2020 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
@@ -22,8 +22,6 @@
#:use-module (system base language)
#:use-module (ice-9 match)
#:use-module (language tree-il)
- #:use-module (language tree-il compile-cps)
- #:use-module (language tree-il compile-bytecode)
#:use-module ((language tree-il analyze) #:select (make-analyzer))
#:use-module ((language tree-il optimize) #:select (make-lowerer))
#:export (tree-il))
@@ -40,11 +38,13 @@
(_ (error "what!" exps env))))
(define (choose-compiler target optimization-level opts)
+ (define (load-compiler compiler)
+ (module-ref (resolve-interface `(language tree-il ,compiler)) compiler))
(if (match (memq #:cps? opts)
((_ cps? . _) cps?)
(#f (<= 1 optimization-level)))
- (cons 'cps compile-cps)
- (cons 'bytecode compile-bytecode)))
+ (cons 'cps (load-compiler 'compile-bytecode))
+ (cons 'bytecode (load-compiler 'compile-bytecode))))
(define-language tree-il
#:title "Tree Intermediate Language"
@@ -52,8 +52,6 @@
#:printer write-tree-il
#:parser parse-tree-il
#:joiner join
- #:compilers `((cps . ,compile-cps)
- (bytecode . ,compile-bytecode))
#:compiler-chooser choose-compiler
#:analyzer make-analyzer
#:lowerer make-lowerer
diff --git a/module/scripts/compile.scm b/module/scripts/compile.scm
index 6440c40..eadd38b 100644
--- a/module/scripts/compile.scm
+++ b/module/scripts/compile.scm
@@ -29,8 +29,8 @@
;;; Code:
(define-module (scripts compile)
- #:use-module ((system base language) #:select (lookup-language))
- #:use-module ((system base compile) #:select (compile-file
+ #:use-module ((system base compile) #:select (compute-compiler
+ compile-file
default-warning-level
default-optimization-level))
#:use-module (system base target)
@@ -250,12 +250,12 @@ Report bugs to <~A>.~%"
(when (assoc-ref options 'install-r7rs?)
(install-r7rs!))
- ;; Load FROM and TO before we have changed the load path. That way, when
- ;; cross-compiling Guile itself, we can be sure we're loading our own
- ;; language modules and not those of the Guile being compiled, which may
- ;; have incompatible .go files.
- (lookup-language from)
- (lookup-language to)
+ ;; Compute a compiler before changing the load path, for its side
+ ;; effects of loading compiler modules. That way, when
+ ;; cross-compiling Guile itself, we can be sure we're loading our
+ ;; own language modules and not those of the Guile being compiled,
+ ;; which may have incompatible .go files.
+ (compute-compiler from to optimization-level warning-level compile-opts)
(set! %load-path (append load-path %load-path))
(set! %load-should-auto-compile #f)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 26b28bf..567765d 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -26,6 +26,7 @@
#:export (compiled-file-name
compile-file
compile-and-load
+ compute-compiler
read-and-compile
compile
decompile
@@ -267,18 +268,16 @@
;; unit.
(values exp env cenv)))))))))
-(define (find-language-joint from to)
- (match (lookup-compilation-order from to)
- (((langs . passes) ...)
- (or (let lp ((langs langs))
- (match langs
- (() #f)
- ((lang . langs)
- (or (lp langs)
- (and (language-joiner lang)
- lang)))))
- to))
- (_ (error "no way to compile" from "to" to))))
+(define (find-language-joint from to optimization-level opts)
+ (let ((from (ensure-language from))
+ (to (ensure-language to)))
+ (let lp ((lang from))
+ (match (next-pass from lang to optimization-level opts)
+ (#f #f)
+ ((next . pass)
+ (or (lp next)
+ (and (language-joiner next)
+ next)))))))
(define (default-language-joiner lang)
(lambda (exps env)
@@ -305,7 +304,7 @@
(opts '()))
(let* ((from (ensure-language from))
(to (ensure-language to))
- (joint (find-language-joint from to)))
+ (joint (find-language-joint from to optimization-level opts)))
(parameterize ((current-language from))
(let lp ((exps '()) (env #f) (cenv env) (from #f) (compile1 #f))
(match (read-and-parse (current-language) port cenv)