dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add language-specific analysis pass to compiler infrastructure

Browse source 
* module/system/base/compile.scm (compute-analyzer): Compute analyzer to
  run on expressions before the compiler runs.
  (add-default-optimizations): Flesh out; still a stub.a
  (read-and-compile, compile, compile-and-load, compile-file): Default
  warning and optimization levels.
  (default-warning-level): New parameter, defaulting to 1.
  (default-optimization-level): New parameter, defaulting to 2.
  Currently unused.
* module/system/base/language.scm (<language>): Add
  optimizations-for-level and analyzer fields.
* module/language/tree-il/compile-bytecode.scm (compile-bytecode):
* module/language/tree-il/compile-cps.scm (optimize-tree-il): No need to
  run warnings passes here; compilers infrastructure will run them.
* module/language/tree-il/spec.scm (tree-il): Define make-analyzer as
  analyzer.
* module/language/tree-il/analyze.scm (make-analyzer): New exported
  procedure.
  (%warning-passes): New private variable.
* .dir-locals.el: Add with-test-prefix/c&e indent mode.
* test-suite/tests/cross-compilation.test:
* test-suite/tests/optargs.test:
* test-suite/tests/tree-il.test: Adjust to disable default warnings.
This commit is contained in:
Andy Wingo 2020-05-08 14:48:47 +02:00
commit 116f94d661
11 changed files with 280 additions and 282 deletions
Download patch file Download diff file Expand all files Collapse all files

28
module/language/tree-il/analyze.scm
View file

@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler
;; Copyright (C) 2001,2008-2014,2016,2018-2019 Free Software Foundation, Inc.
;; Copyright (C) 2001,2008-2014,2016,2018-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
@ -37,7 +37,8 @@
unbound-variable-analysis
macro-use-before-definition-analysis
arity-analysis
format-analysis))
format-analysis
make-analyzer))
;;;
;;; Tree analyses for warnings.
@ -1086,3 +1087,26 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
#t)
#t))
(define %warning-passes
`(#(unused-variable 3 ,unused-variable-analysis)
#(unused-toplevel 2 ,unused-toplevel-analysis)
#(shadowed-toplevel 2 ,shadowed-toplevel-analysis)
#(unbound-variable 1 ,unbound-variable-analysis)
#(macro-use-before-definition 1 ,macro-use-before-definition-analysis)
#(arity-mismatch 1 ,arity-analysis)
#(format 1 ,format-analysis)))
(define (make-analyzer warning-level warnings)
(define (enabled-for-level? level)
(match warning-level
((? boolean?) warning-level)
((? exact-integer?) (>= warning-level level))))
(let ((analyses (filter-map (match-lambda
(#(kind level analysis)
(and (or (enabled-for-level? level)
(memq kind warnings))
analysis)))
%warning-passes)))
(lambda (exp env)
(analyze-tree analyses exp env))))

50
module/language/tree-il/compile-bytecode.scm
View file

@ -2,19 +2,18 @@
;; Copyright (C) 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
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;
@ -42,7 +41,6 @@
#:use-module (ice-9 match)
#:use-module (language bytecode)
#:use-module (language tree-il)
#:use-module (language tree-il analyze)
#:use-module (language tree-il optimize)
#:use-module ((srfi srfi-1) #:select (filter-map
fold
@ -1316,35 +1314,13 @@ in the frame with for the lambda-case clause @var{clause}."
(emit-clause #f body module-scope free)
(emit-end-program asm))))
(define %warning-passes
`((unused-variable . ,unused-variable-analysis)
(unused-toplevel . ,unused-toplevel-analysis)
(shadowed-toplevel . ,shadowed-toplevel-analysis)
(unbound-variable . ,unbound-variable-analysis)
(macro-use-before-definition . ,macro-use-before-definition-analysis)
(arity-mismatch . ,arity-analysis)
(format . ,format-analysis)))
(define (optimize-tree-il x e opts)
(define warnings
(or (and=> (memq #:warnings opts) cadr)
'()))
;; Go through the warning passes.
(let ((analyses (filter-map (lambda (kind)
(assoc-ref %warning-passes kind))
warnings)))
(analyze-tree analyses x e))
(optimize x e opts))
(define (kw-arg-ref args kw default)
(match (memq kw args)
((_ val . _) val)
(_ default)))
(define (compile-bytecode exp env opts)
(let* ((exp (canonicalize (optimize-tree-il exp env opts)))
(let* ((exp (canonicalize (optimize exp env opts)))
(asm (make-assembler)))
(call-with-values (lambda () (split-closures exp))
(lambda (closures assigned)

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

@ -60,7 +60,6 @@
#:use-module (language cps utils)
#:use-module (language cps with-cps)
#:use-module (language tree-il cps-primitives)
#:use-module (language tree-il analyze)
#:use-module (language tree-il optimize)
#:use-module (language tree-il)
#:use-module (language cps intmap)
@ -2324,28 +2323,6 @@ integer."
(define *comp-module* (make-fluid))
(define %warning-passes
`((unused-variable . ,unused-variable-analysis)
(unused-toplevel . ,unused-toplevel-analysis)
(shadowed-toplevel . ,shadowed-toplevel-analysis)
(unbound-variable . ,unbound-variable-analysis)
(macro-use-before-definition . ,macro-use-before-definition-analysis)
(arity-mismatch . ,arity-analysis)
(format . ,format-analysis)))
(define (optimize-tree-il x e opts)
(define warnings
(or (and=> (memq #:warnings opts) cadr)
'()))
;; Go through the warning passes.
(let ((analyses (filter-map (lambda (kind)
(assoc-ref %warning-passes kind))
warnings)))
(analyze-tree analyses x e))
(optimize x e opts))
(define (canonicalize exp)
(define-syntax-rule (with-lexical src id . body)
(let ((k (lambda (id) . body)))
@ -2560,8 +2537,7 @@ integer."
exp))
(define (compile-cps exp env opts)
(values (cps-convert/thunk
(canonicalize (optimize-tree-il exp env opts)))
(values (cps-convert/thunk (canonicalize (optimize exp env opts)))
env
env))

2
module/language/tree-il/spec.scm
View file

@ -23,6 +23,7 @@
#:use-module (system base pmatch)
#:use-module (language tree-il)
#:use-module (language tree-il compile-cps)
#:use-module ((language tree-il analyze) #:select (make-analyzer))
#:export (tree-il))
(define (write-tree-il exp . port)
@ -43,4 +44,5 @@
#:parser parse-tree-il
#:joiner join
#:compilers `((cps . ,compile-cps))
#:analyzer make-analyzer
#:for-humans? #f)

46
module/system/base/compile.scm
View file

@ -28,9 +28,22 @@
compile-and-load
read-and-compile
compile
decompile))
decompile
default-warning-level
default-optimization-level))
(define (level-validator x)
(match x
((? boolean?) x)
((and (? exact-integer?) (not (? negative?))) x)
(_ (error
"bad warning or optimization level: expected #f, #t, or integer >= 0"
x))))
(define default-warning-level (make-parameter 1 level-validator))
(define default-optimization-level (make-parameter 2 level-validator))
;;;
;;; Compiler
;;;
@ -156,8 +169,8 @@
(from (current-language))
(to 'bytecode)
(env (default-environment from))
(optimization-level #f)
(warning-level #f)
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '())
(canonicalization 'relative))
(validate-options opts)
@ -183,8 +196,10 @@
comp)))
(define* (compile-and-load file #:key (from (current-language)) (to 'value)
(env (current-module)) (optimization-level #f)
(warning-level #f) (opts '())
(env (current-module))
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '())
(canonicalization 'relative))
(validate-options opts)
(with-fluids ((%file-port-name-canonicalization canonicalization))
@ -200,10 +215,19 @@
;;;
(define (compute-analyzer lang warning-level opts)
(lambda (exp env) #t))
(match (language-analyzer lang)
(#f (lambda (exp env) (values)))
(proc (proc warning-level
(let lp ((opts opts))
(match opts
(() '())
((#:warnings warnings . _) warnings)
((_ _ . opts) (lp opts))))))))
(define (add-default-optimizations lang optimization-level opts)
opts)
(match (language-optimizations-for-level lang)
(#f opts)
(get-opts (append opts (get-opts optimization-level)))))
(define (compute-compiler from to optimization-level warning-level opts)
(let lp ((order (or (lookup-compilation-order from to)
@ -258,8 +282,8 @@
(from (current-language))
(to 'bytecode)
(env (default-environment from))
(optimization-level #f)
(warning-level #f)
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '()))
(let* ((from (ensure-language from))
(to (ensure-language to))
@ -298,8 +322,8 @@
(from (current-language))
(to 'value)
(env (default-environment from))
(optimization-level #f)
(warning-level #f)
(optimization-level (default-optimization-level))
(warning-level (default-warning-level))
(opts '()))
(validate-options opts)
(let ((compile1 (compute-compiler from to optimization-level

6
module/system/base/language.scm
View file

@ -27,6 +27,8 @@
language-compilers language-decompilers language-evaluator
language-joiner language-for-humans?
language-make-default-environment
language-optimizations-for-level
language-analyzer
lookup-compilation-order lookup-decompilation-order
default-environment)
@ -49,7 +51,9 @@
(evaluator #f)
(joiner #f)
(for-humans? #t)
(make-default-environment make-fresh-user-module))
(make-default-environment make-fresh-user-module)
(optimizations-for-level #f)
(analyzer #f))
(define-syntax-rule (define-language name . spec)
(define name (make-language #:name 'name . spec)))

25
module/system/base/message.scm
View file

@ -1,20 +1,19 @@
;;; User interface messages
;; Copyright (C) 2009, 2010, 2011, 2012, 2018 Free Software Foundation, Inc.
;; Copyright (C) 2009-2012,2016,2018,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
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;
@ -234,5 +233,3 @@ property alist) using the data in ARGS."
args)
(format port "~A: unknown warning type `~A': ~A~%"
(location-string location) type args))))
;;; message.scm ends here