mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-23 03:54:12 +02:00
tree-il-src is a vector, replaces tree-il-srcv
* module/language/tree-il.scm (tree-il-src): Always a vector now;
tree-il-srcv is gone. An incompatible change but we are in the
compiler.
(location): For parse-tree-il, make vector locations instead of alists.
* module/language/tree-il/analyze.scm:
* module/language/tree-il/compile-bytecode.scm:
* module/language/tree-il/compile-cps.scm:
* module/language/tree-il/debug.scm:
* module/language/tree-il/letrectify.scm:
* module/language/tree-il/peval.scm:
* module/system/vm/assembler.scm: Update all uses to expect vectors
instead of alists and to use tree-il-src instead of tree-il-srcv.
* module/language/elisp/compile-tree-il.scm (location): Create vectors,
not alists.
* test-suite/tests/compiler.test ("psyntax"): Update syntax-source
expectation.
This commit is contained in:
Andy Wingo
parent
f399f36d37
commit
9ab8f3d807
10 changed files with 39 additions and 57 deletions
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile Emacs Lisp
|
||||
|
||||
;; Copyright (C) 2009-2011, 2013, 2018 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2009-2011, 2013, 2018, 2025 Free Software Foundation, Inc.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -69,7 +69,9 @@
|
|||
(and (pair? x)
|
||||
(let ((props (source-properties x)))
|
||||
(and (not (null? props))
|
||||
props))))
|
||||
(vector (assq-ref props 'filename)
|
||||
(assq-ref props 'line)
|
||||
(assq-ref props 'column))))))
|
||||
|
||||
;;; Values to use for Elisp's nil and t.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;;; Copyright (C) 2009-2014,2017-2020,2022-2023 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2009-2014,2017-2020,2022-2023,2025 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/ensure-alist . tree-il-src)
|
||||
(tree-il-src . tree-il-srcv)
|
||||
#:export (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,19 +135,6 @@
|
|||
(<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))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -166,7 +152,10 @@
|
|||
(define (location x)
|
||||
(and (pair? x)
|
||||
(let ((props (source-properties x)))
|
||||
(and (pair? props) props))))
|
||||
(and (pair? props)
|
||||
(vector (assq-ref props 'filename)
|
||||
(assq-ref props 'line)
|
||||
(assq-ref props 'column))))))
|
||||
|
||||
(define (parse-tree-il exp)
|
||||
(let ((loc (location exp))
|
||||
|
|
|
|||
|
|
@ -71,7 +71,7 @@ given `tree-il' element."
|
|||
(cdr results))))))
|
||||
|
||||
;; Extending and shrinking the location stack.
|
||||
(define (extend-locs x locs) (cons (tree-il-srcv x) locs))
|
||||
(define (extend-locs x locs) (cons (tree-il-src x) locs))
|
||||
(define (shrink-locs x locs) (cdr locs))
|
||||
|
||||
(let ((results
|
||||
|
|
@ -114,7 +114,7 @@ given `tree-il' element."
|
|||
;; accordingly.
|
||||
(let ((refs (binding-info-refs info))
|
||||
(vars (binding-info-vars info))
|
||||
(src (tree-il-srcv x)))
|
||||
(src (tree-il-src x)))
|
||||
(define (extend inner-vars inner-names)
|
||||
(fold (lambda (var name vars)
|
||||
(vhash-consq var (list name src) vars))
|
||||
|
|
@ -525,7 +525,7 @@ given `tree-il' element."
|
|||
(match (vhash-assq name defs)
|
||||
((_ . previous-definition)
|
||||
(warning 'shadowed-toplevel src name
|
||||
(tree-il-srcv previous-definition))
|
||||
(tree-il-src previous-definition))
|
||||
defs)
|
||||
(#f
|
||||
(vhash-consq name x defs))))
|
||||
|
|
@ -926,7 +926,7 @@ given `tree-il' element."
|
|||
(values #f #f))))))))
|
||||
|
||||
(let ((args (call-args call))
|
||||
(src (tree-il-srcv call)))
|
||||
(src (tree-il-src call)))
|
||||
(call-with-values (lambda () (arities proc))
|
||||
(lambda (name arities)
|
||||
(define matches?
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Lightweight compiler directly from Tree-IL to bytecode
|
||||
|
||||
;; Copyright (C) 2020-2021,2023 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2020-2021,2023,2025 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
|
||||
|
|
@ -604,7 +604,7 @@
|
|||
(()
|
||||
(let ()
|
||||
(define x-thunk
|
||||
(let ((src (tree-il-srcv exp)))
|
||||
(let ((src (tree-il-src exp)))
|
||||
(make-lambda src '()
|
||||
(make-lambda-case src '() #f #f #f '() '() exp #f))))
|
||||
(values (cons (make-closure 'init x-thunk #f '())
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Continuation-passing style (CPS) intermediate language (IL)
|
||||
|
||||
;; Copyright (C) 2013-2015,2017-2021,2023 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2013-2015,2017-2021,2023,2025 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
|
||||
|
|
@ -1309,7 +1309,7 @@ use as the proc slot."
|
|||
(define (init-default-value cps name sym subst init body)
|
||||
(match (hashq-ref subst sym)
|
||||
((orig-var subst-var box?)
|
||||
(let ((src (tree-il-srcv init)))
|
||||
(let ((src (tree-il-src init)))
|
||||
(define (maybe-box cps k make-body)
|
||||
(if box?
|
||||
(with-cps cps
|
||||
|
|
@ -1964,10 +1964,10 @@ use as the proc slot."
|
|||
(lambda (cps thunk)
|
||||
(with-cps cps
|
||||
(letk kbody ($kargs () ()
|
||||
($continue krest (tree-il-srcv body)
|
||||
($continue krest (tree-il-src body)
|
||||
($primcall 'call-thunk/no-inline #f
|
||||
(thunk)))))
|
||||
(build-term ($prompt kbody khargs (tree-il-srcv body)
|
||||
(build-term ($prompt kbody khargs (tree-il-src body)
|
||||
#f tag)))))))
|
||||
(with-cps cps
|
||||
(letv prim vals apply)
|
||||
|
|
@ -2223,7 +2223,7 @@ integer."
|
|||
(letk kclause ($kclause ('() '() #f '() #f) kbody #f))
|
||||
($ ((lambda (cps)
|
||||
(let ((init (build-cont
|
||||
($kfun (tree-il-srcv exp) '() init ktail kclause))))
|
||||
($kfun (tree-il-src exp) '() init ktail kclause))))
|
||||
(with-cps (persistent-intmap (intmap-replace! cps kinit init))
|
||||
kinit))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -244,7 +244,7 @@
|
|||
(visit tail env))
|
||||
(_
|
||||
(error "unexpected tree-il" exp)))
|
||||
(match (tree-il-srcv exp)
|
||||
(match (tree-il-src exp)
|
||||
(#f #t)
|
||||
(#((or #f (? string?)) (? exact-integer?) (? exact-integer?)) #t)
|
||||
(src (error "bad src" src)))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; transformation of top-level bindings into letrec*
|
||||
|
||||
;; Copyright (C) 2019-2021,2023 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2019-2021,2023,2025 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
|
||||
|
|
@ -190,7 +190,7 @@
|
|||
(cons name names) (cons var vars) (cons val vals)
|
||||
tail))
|
||||
(_
|
||||
(make-letrec (tree-il-srcv tail) #t
|
||||
(make-letrec (tree-il-src tail) #t
|
||||
(list name) (list var) (list val)
|
||||
tail))))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Tree-IL partial evaluator
|
||||
|
||||
;; Copyright (C) 2011-2014,2017,2019-2024 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2011-2014,2017,2019-2025 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
|
||||
|
|
@ -110,7 +110,7 @@
|
|||
"Discard all but the first value of X."
|
||||
(if (singly-valued-expression? x)
|
||||
x
|
||||
(make-primcall (tree-il-srcv x) 'values (list x))))
|
||||
(make-primcall (tree-il-src x) 'values (list x))))
|
||||
|
||||
;; Peval will do a one-pass analysis on the source program to determine
|
||||
;; the set of assigned lexicals, and to identify unreferenced and
|
||||
|
|
|
|||
|
|
@ -582,7 +582,7 @@ N-byte unit."
|
|||
|
||||
;; A list of (pos . source) pairs, indicating source information. POS
|
||||
;; is relative to the beginning of the text section, and SOURCE is in
|
||||
;; the same format that source-properties returns.
|
||||
;; the same format that syntax-sourcev returns.
|
||||
;;
|
||||
(sources asm-sources set-asm-sources!)
|
||||
|
||||
|
|
@ -2900,26 +2900,17 @@ procedure with label @var{rw-init}. @var{rw-init} may be false. If
|
|||
|
||||
(let lp ((sources (asm-sources asm)) (out '()))
|
||||
(match sources
|
||||
(((pc . location) . sources)
|
||||
(let-values (((file line col)
|
||||
;; Usually CPS records contain a "source
|
||||
;; vector" coming from tree-il, but some might
|
||||
;; contain a source property alist.
|
||||
(match location
|
||||
(#(file line col) (values file line col))
|
||||
(lst (values (assq-ref lst 'filename)
|
||||
(assq-ref lst 'line)
|
||||
(assq-ref lst 'column))))))
|
||||
(lp sources
|
||||
;; Guile line and column numbers are 0-indexed, but
|
||||
;; they are 1-indexed for DWARF.
|
||||
(if (and line col)
|
||||
(cons (list pc
|
||||
(if (string? file) (intern-file file) 0)
|
||||
(1+ line)
|
||||
(1+ col))
|
||||
out)
|
||||
out))))
|
||||
(((pc . #(file line col)) . sources)
|
||||
(lp sources
|
||||
;; Guile line and column numbers are 0-indexed, but
|
||||
;; they are 1-indexed for DWARF.
|
||||
(if (and line col)
|
||||
(cons (list pc
|
||||
(if (string? file) (intern-file file) 0)
|
||||
(1+ line)
|
||||
(1+ col))
|
||||
out)
|
||||
out)))
|
||||
(()
|
||||
;; Compilation unit header for .debug_line. We write in
|
||||
;; DWARF 2 format because more tools understand it than DWARF
|
||||
|
|
|
|||
|
|
@ -75,7 +75,7 @@
|
|||
(eq? round (module-ref m 'round))))
|
||||
|
||||
(pass-if-equal "syntax-source with read-hash-extend"
|
||||
'((filename . "sample.scm") (line . 2) (column . 5))
|
||||
#("sample.scm" 2 5)
|
||||
(with-fluids ((%read-hash-procedures
|
||||
(fluid-ref %read-hash-procedures)))
|
||||
(read-hash-extend #\~ (lambda (chr port)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue