diff options
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/tree-il.scm | 19 | ||||
-rw-r--r-- | module/language/tree-il/analyze.scm | 8 |
2 files changed, 20 insertions, 7 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 974fce29e..a7dc3c079 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -1,4 +1,4 @@ -;;;; Copyright (C) 2009-2014, 2017-2020 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014, 2017-2020, 2022 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 @@ -21,8 +21,7 @@ #:use-module (srfi srfi-11) #:use-module (ice-9 match) #:use-module (system base syntax) - #:export (tree-il-src - + #:export ((tree-il-src/ensure-alist . tree-il-src) <void> void? make-void void-src <const> const? make-const const-src const-exp <primitive-ref> primitive-ref? make-primitive-ref primitive-ref-src primitive-ref-name @@ -136,6 +135,20 @@ (<prompt> escape-only? tag body handler) (<abort> tag args tail)) +(define tree-il-src/ensure-alist + (make-procedure-with-setter + (lambda (tree) + "Return the source location of TREE as a source property alist." + ;; psyntax gives us "source vectors"; convert them lazily to reduce + ;; allocations. + (match (tree-il-src tree) + (#(file line column) + `((filename . ,file) (line . ,line) (column . ,column))) + (src + src))) + (lambda (tree src) + (set! (tree-il-src tree) src)))) + ;; A helper. diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 1567e3ec5..7918b9ddd 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -1,6 +1,6 @@ ;;; Diagnostic warnings for Tree-IL -;; Copyright (C) 2001,2008-2014,2016,2018-2021 Free Software Foundation, Inc. +;; Copyright (C) 2001,2008-2014,2016,2018-2022 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 @@ -346,11 +346,11 @@ given `tree-il' element." (lambda (x defs env locs) ;; Going down into X. (record-case x - ((<toplevel-define> name src) + ((<toplevel-define> name) (match (vhash-assq name defs) ((_ . previous-definition) - (warning 'shadowed-toplevel src name - (toplevel-define-src previous-definition)) + (warning 'shadowed-toplevel (tree-il-src x) name + (tree-il-src previous-definition)) defs) (#f (vhash-consq name x defs)))) |