optimize.scm 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344
  1. ;;; Optimization flags
  2. ;; Copyright (C) 2018 Free Software Foundation, Inc.
  3. ;;;; This library is free software; you can redistribute it and/or
  4. ;;;; modify it under the terms of the GNU Lesser General Public
  5. ;;;; License as published by the Free Software Foundation; either
  6. ;;;; version 3 of the License, or (at your option) any later version.
  7. ;;;;
  8. ;;;; This library is distributed in the hope that it will be useful,
  9. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  11. ;;;; Lesser General Public License for more details.
  12. ;;;;
  13. ;;;; You should have received a copy of the GNU Lesser General Public
  14. ;;;; License along with this library; if not, write to the Free Software
  15. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16. ;;; Code:
  17. (define-module (system base optimize)
  18. #:use-module (language tree-il optimize)
  19. #:use-module (language cps optimize)
  20. #:use-module (ice-9 match)
  21. #:export (available-optimizations
  22. pass-optimization-level
  23. optimizations-for-level))
  24. (define (available-optimizations)
  25. (append (tree-il-optimizations) (cps-optimizations)))
  26. (define (pass-optimization-level kw)
  27. (match (assq kw (available-optimizations))
  28. ((kw level) level)
  29. (_ (error "unknown optimization" kw))))
  30. ;; Turn on all optimizations unless -O0.
  31. (define (optimizations-for-level level)
  32. (let lp ((options (available-optimizations)))
  33. (match options
  34. (() '())
  35. (((kw at-level) . options)
  36. (cons* kw (<= at-level level) (lp options))))))