;;; Diagnostic warnings for Tree-IL

;; Copyright (C) 2001,2008-2014,2016,2018-2023 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

;;; Code:

(define-module (language tree-il analyze)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 vlist)
  #:use-module (ice-9 match)
  #:use-module (system base syntax)
  #:use-module (system base message)
  #:use-module (system vm program)
  #:use-module (language tree-il)
  #:use-module (system base pmatch)
  #:export (analyze-tree
            unused-variable-analysis
            unused-toplevel-analysis
            shadowed-toplevel-analysis
            make-use-before-definition-analysis
            arity-analysis
            format-analysis
            make-analyzer))

;;;
;;; Tree analyses for warnings.
;;;

(define-record-type <tree-analysis>
  (make-tree-analysis down up post init)
  tree-analysis?
  (down tree-analysis-down)  ;; (lambda (x result env locs) ...)
  (up   tree-analysis-up)    ;; (lambda (x result env locs) ...)
  (post tree-analysis-post)  ;; (lambda (result env) ...)
  (init tree-analysis-init)) ;; arbitrary value

(define (analyze-tree analyses tree env)
  "Run all tree analyses listed in ANALYSES on TREE for ENV, using
`tree-il-fold'.  Return TREE.  The down and up procedures of each
analysis are passed a ``location stack', which is the stack of
`tree-il-src' values for each parent tree (a list); it can be used to
approximate source location when accurate information is missing from a
given `tree-il' element."

  (define (traverse proc update-locs)
    ;; Return a tree traversing procedure that returns a list of analysis
    ;; results prepended by the location stack.
    (lambda (x results)
      (let ((locs (update-locs x (car results))))
        (cons locs ;; the location stack
              (map (lambda (analysis result)
                     ((proc analysis) x result env locs))
                   analyses
                   (cdr results))))))

  ;; Extending and shrinking the location stack.
  (define (extend-locs x locs) (cons (tree-il-srcv x) locs))
  (define (shrink-locs x locs) (cdr locs))

  (let ((results
         (tree-il-fold (traverse tree-analysis-down extend-locs)
                       (traverse tree-analysis-up   shrink-locs)
                       (cons '() ;; empty location stack
                             (map tree-analysis-init analyses))
                       tree)))

    (for-each (lambda (analysis result)
                ((tree-analysis-post analysis) result env))
              analyses
              (cdr results)))

  tree)