mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Wire up `guild compile -O0 foo.scm'

Browse source 
* module/scripts/compile.scm (%options): Resurrect -O option and make it
  follow GCC, more or less.  The default is equivalent to -O2.

* module/language/cps/compile-bytecode.scm (lower-cps):
* module/language/cps/optimize.scm (optimize-higher-order-cps): Move
  split-rec to run unconditionally for now, as closure conversion fails
  without it.
  (define-optimizer): Only verify the result if we are debugging, to
  save time.
  (cps-default-optimization-options): New exported procedure.

* module/language/tree-il/optimize.scm
  (tree-il-default-optimization-options): New exported procedure.
This commit is contained in:
Andy Wingo 2015-10-22 17:44:17 +00:00
parent 2d4da30fde
commit f169be9fc8
4 changed files with 105 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/cps/compile-bytecode.scm
View file

@ -34,6 +34,7 @@
#:use-module (language cps optimize)
#:use-module (language cps reify-primitives)
#:use-module (language cps renumber)
#:use-module (language cps split-rec)
#:use-module (language cps intmap)
#:use-module (language cps intset)
#:use-module (system vm assembler)
@ -513,6 +514,11 @@
env)))
(define (lower-cps exp opts)
;; FIXME: For now the closure conversion pass relies on $rec instances
;; being separated into SCCs. We should fix this to not be the case,
;; and instead move the split-rec pass back to
;; optimize-higher-order-cps.
(set! exp (split-rec exp))
(set! exp (optimize-higher-order-cps exp opts))
(set! exp (convert-closures exp))
(set! exp (optimize-first-order-cps exp opts))

29
module/language/cps/optimize.scm
View file

@ -37,11 +37,11 @@
#:use-module (language cps self-references)
#:use-module (language cps simplify)
#:use-module (language cps specialize-primcalls)
#:use-module (language cps split-rec)
#:use-module (language cps type-fold)
#:use-module (language cps verify)
#:export (optimize-higher-order-cps
optimize-first-order-cps))
optimize-first-order-cps
cps-default-optimization-options))
(define (kw-arg-ref args kw default)
(match (memq kw args)
@ -75,8 +75,7 @@
(maybe-verify (pass program))
program))
...
(verify program)
program))
(maybe-verify program)))
;; Passes that are needed:
;;
@ -84,7 +83,11 @@
;; calls, and eliding prompts if possible.
;;
(define-optimizer optimize-higher-order-cps
(split-rec #:split-rec? #t)
;; FIXME: split-rec call temporarily moved to compile-bytecode and run
;; unconditionally, because closure conversion requires it. Move the
;; pass back here when that's fixed.
;;
;; (split-rec #:split-rec? #t)
(eliminate-dead-code #:eliminate-dead-code? #t)
(prune-top-level-scopes #:prune-top-level-scopes? #t)
(simplify #:simplify? #t)
@ -106,3 +109,19 @@
(eliminate-dead-code #:eliminate-dead-code? #t)
(rotate-loops #:rotate-loops? #t)
(simplify #:simplify? #t))
(define (cps-default-optimization-options)
(list ;; #:split-rec? #t
#:eliminate-dead-code? #t
#:prune-top-level-scopes? #t
#:contify? #t
#:inline-constructors? #t
#:specialize-primcalls? #t
#:elide-values? #t
#:prune-bailouts? #t
#:peel-loops? #t
#:cse? #t
#:type-fold? #t
#:resolve-self-references? #t
#:licm? #t
#:rotate-loops? #t))

8
module/language/tree-il/optimize.scm
View file

@ -1,6 +1,6 @@
;;; Tree-il optimizer
;; Copyright (C) 2009, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;; Copyright (C) 2009, 2011, 2012, 2013, 2014, 2015 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
@ -25,7 +25,8 @@
#:use-module (language tree-il fix-letrec)
#:use-module (language tree-il debug)
#:use-module (ice-9 match)
#:export (optimize))
#:export (optimize
tree-il-default-optimization-options))
(define (optimize x env opts)
(let ((peval (match (memq #:partial-eval? opts)
@ -37,3 +38,6 @@
(verify-tree-il
(peval (expand-primitives (resolve-primitives x env))
env)))))
(define (tree-il-default-optimization-options)
'(#:partial-eval? #t))

77
module/scripts/compile.scm
View file

@ -1,6 +1,6 @@
;;; Compile --- Command-line Guile Scheme compiler -*- coding: iso-8859-1 -*-
;; Copyright 2005, 2008-2011, 2013, 2014 Free Software Foundation, Inc.
;; Copyright 2005, 2008-2011, 2013, 2014, 2015 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@ -32,10 +32,13 @@
#:use-module ((system base compile) #:select (compile-file))
#:use-module (system base target)
#:use-module (system base message)
#:use-module (language tree-il optimize)
#:use-module (language cps optimize)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-13)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (compile))
(define %summary "Compile a file.")
@ -45,6 +48,20 @@
(format (current-error-port) "error: ~{~a~}~%" messages)
(exit 1))
(define (available-optimizations)
(append (tree-il-default-optimization-options)
(cps-default-optimization-options)))
;; Turn on all optimizations unless -O0.
(define (optimizations-for-level level)
(let lp ((options (available-optimizations)))
(match options
(() '())
((#:partial-eval? val . options)
(cons* #:partial-eval? (> level 0) (lp options)))
((kw val . options)
(cons* kw (> level 1) (lp options))))))
(define %options
;; Specifications of the command-line options.
(list (option '(#\h "help") #f #f
@ -77,9 +94,28 @@
(cons (string->symbol arg) warnings)
(alist-delete 'warnings result))))))
(option '(#\O "optimize") #f #f
(option '(#\O "optimize") #t #f
(lambda (opt name arg result)
(alist-cons 'optimize? #t result)))
(define (return val)
(alist-cons 'optimizations val result))
(define (return-option name val)
(let ((kw (symbol->keyword
(string->symbol (string-append name "?")))))
(unless (memq kw (available-optimizations))
(fail "Unknown optimization pass `~a'" name))
(return (list kw val))))
(cond
((string=? arg "help")
(show-optimization-help)
(exit 0))
((equal? arg "0") (return (optimizations-for-level 0)))
((equal? arg "1") (return (optimizations-for-level 1)))
((equal? arg "2") (return (optimizations-for-level 2)))
((equal? arg "3") (return (optimizations-for-level 3)))
((string-prefix? "no-" arg)
(return-option (substring arg 3) #f))
(else
(return-option arg #t)))))
(option '(#\f "from") #t #f
(lambda (opt name arg result)
(if (assoc-ref result 'from)
@ -129,15 +165,38 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
%warning-types)
(format #t "~%"))
(define (show-optimization-help)
(format #t "The available optimizations are:~%~%")
(let lp ((options (available-optimizations)))
(match options
(() #t)
((kw val . options)
(let ((name (string-trim-right (symbol->string (keyword->symbol kw))
#\?)))
(format #t " -O~a~%"
(if val name (string-append "no-" name)))
(lp options)))))
(format #t "~%")
(format #t "To disable an optimization, prepend it with `no-', for example~%")
(format #t "`-Ono-cse.'~%~%")
(format #t "You may also specify optimization levels as `-O0', `-O1',~%")
(format #t "`-O2', or `-O3'. Currently `-O0' turns off all optimizations,~%")
(format #t "`-O1' turns on partial evaluation, and `-O2' and `-O3' turn on~%")
(format #t "everything. The default is equivalent to `-O2'.")
(format #t "~%"))
(define (compile . args)
(let* ((options (parse-args args))
(help? (assoc-ref options 'help?))
(compile-opts (let ((o `(#:warnings
,(assoc-ref options 'warnings))))
(if (assoc-ref options 'optimize?)
(cons #:O o)
o)))
(compile-opts `(#:warnings
,(assoc-ref options 'warnings)
,@(append-map
(lambda (opt)
(match opt
(('optimizations . opts) opts)
(_ '())))
options)))
(from (or (assoc-ref options 'from) 'scheme))
(to (or (assoc-ref options 'to) 'bytecode))
(target (or (assoc-ref options 'target) %host-type))
@ -156,6 +215,8 @@ Compile each Guile source file FILE into a Guile object.
-W, --warn=WARNING emit warnings of type WARNING; use `--warn=help'
for a list of available warnings
-O, --optimize=OPT specify optimization passes to run; use `-Ohelp'
for a list of available optimizations
-f, --from=LANG specify a source language other than `scheme'
-t, --to=LANG specify a target language other than `bytecode'