[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Use tree-il-srcv instead of tree-il-src
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/02: Use tree-il-srcv instead of tree-il-src |
|
Date: |
Tue, 28 Mar 2023 10:43:36 -0400 (EDT) |
wingo pushed a commit to branch wip-tailify
in repository guile.
commit 1858b10fa6bdbf97f7af98bdedb39c411d4b0693
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Mar 28 16:10:38 2023 +0200
Use tree-il-srcv instead of tree-il-src
This prevents eager conversion to alists.
---
module/language/cps/dump.scm | 14 ++++++++------
module/language/tree-il.scm | 3 ++-
module/language/tree-il/analyze.scm | 8 ++++----
module/language/tree-il/compile-bytecode.scm | 4 ++--
module/language/tree-il/compile-cps.scm | 10 +++++-----
module/language/tree-il/debug.scm | 14 +++++++-------
module/language/tree-il/letrectify.scm | 4 ++--
module/language/tree-il/peval.scm | 4 ++--
8 files changed, 32 insertions(+), 29 deletions(-)
diff --git a/module/language/cps/dump.scm b/module/language/cps/dump.scm
index 1dec80881..cf2174ca9 100644
--- a/module/language/cps/dump.scm
+++ b/module/language/cps/dump.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013, 2014, 2015, 2017, 2018, 2019, 2020, 2021 Free Software
Foundation, Inc.
+;; Copyright (C) 2021,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
@@ -114,11 +114,13 @@
(define (format-name name) (if name (symbol->string name) "_"))
(define (format-var var) (format #f "v~a" var))
(define (format-loc src)
- (and src
- (format #f "~a:~a:~a"
- (or (assq-ref src 'filename) "<unknown>")
- (1+ (assq-ref src 'line))
- (assq-ref src 'column))))
+ (match src
+ (#f #f)
+ (#(filename line column)
+ (format #f "~a:~a:~a"
+ (or filename "<unknown>")
+ (1+ line)
+ column))))
(define (arg-list strs) (string-join strs ", "))
(define (false-if-empty str) (if (string-null? str) #f str))
(define (format-arity arity)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index a7dc3c079..9ff7158b8 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2009-2014, 2017-2020, 2022 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2014,2017-2020,2022-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
@@ -22,6 +22,7 @@
#: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)
<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
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 7bea698f3..a289a4195 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -71,7 +71,7 @@ given `tree-il' element."
(cdr results))))))
;; Extending and shrinking the location stack.
- (define (extend-locs x locs) (cons (tree-il-src x) locs))
+ (define (extend-locs x locs) (cons (tree-il-srcv 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-src x)))
+ (src (tree-il-srcv x)))
(define (extend inner-vars inner-names)
(fold (lambda (var name vars)
(vhash-consq var (list name src) vars))
@@ -350,7 +350,7 @@ given `tree-il' element."
(match (vhash-assq name defs)
((_ . previous-definition)
(warning 'shadowed-toplevel src name
- (tree-il-src previous-definition))
+ (tree-il-srcv previous-definition))
defs)
(#f
(vhash-consq name x defs))))
@@ -751,7 +751,7 @@ given `tree-il' element."
(values #f #f))))))))
(let ((args (call-args call))
- (src (tree-il-src call)))
+ (src (tree-il-srcv call)))
(call-with-values (lambda () (arities proc))
(lambda (name arities)
(define matches?
diff --git a/module/language/tree-il/compile-bytecode.scm
b/module/language/tree-il/compile-bytecode.scm
index 909a311b4..71f22dde7 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -1,6 +1,6 @@
;;; Lightweight compiler directly from Tree-IL to bytecode
-;; Copyright (C) 2020, 2021 Free Software Foundation, Inc.
+;; Copyright (C) 2020-2021,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
@@ -638,7 +638,7 @@
(()
(let ()
(define x-thunk
- (let ((src (tree-il-src exp)))
+ (let ((src (tree-il-srcv exp)))
(make-lambda src '()
(make-lambda-case src '() #f #f #f '() '() exp #f))))
(values (cons (make-closure 'init x-thunk #f '())
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index de565ec2b..3ee596ff7 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1,6 +1,6 @@
;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013-2015,2017-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015,2017-2021,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
@@ -1542,7 +1542,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-src init)))
+ (let ((src (tree-il-srcv init)))
(define (maybe-box cps k make-body)
(if box?
(with-cps cps
@@ -2150,10 +2150,10 @@ use as the proc slot."
(lambda (cps thunk)
(with-cps cps
(letk kbody ($kargs () ()
- ($continue krest (tree-il-src body)
+ ($continue krest (tree-il-srcv body)
($primcall 'call-thunk/no-inline #f
(thunk)))))
- (build-term ($prompt kbody khargs (tree-il-src body)
+ (build-term ($prompt kbody khargs (tree-il-srcv body)
#f tag)))))))
(with-cps cps
(letv prim vals apply)
@@ -2394,7 +2394,7 @@ integer."
(letk kclause ($kclause ('() '() #f '() #f) kbody #f))
($ ((lambda (cps)
(let ((init (build-cont
- ($kfun (tree-il-src exp) '() init ktail kclause))))
+ ($kfun (tree-il-srcv exp) '() init ktail kclause))))
(with-cps (persistent-intmap (intmap-replace! cps kinit init))
kinit))))))))
diff --git a/module/language/tree-il/debug.scm
b/module/language/tree-il/debug.scm
index 3878fb526..773b84bee 100644
--- a/module/language/tree-il/debug.scm
+++ b/module/language/tree-il/debug.scm
@@ -1,6 +1,6 @@
;;; Tree-IL verifier
-;; Copyright (C) 2011, 2013, 2019 Free Software Foundation, Inc.
+;; Copyright (C) 2011,2013,2019,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
@@ -244,9 +244,9 @@
(visit tail env))
(_
(error "unexpected tree-il" exp)))
- (let ((src (tree-il-src exp)))
- (if (and src (not (and (list? src) (and-map pair? src)
- (and-map symbol? (map car src)))))
- (error "bad src"))
- ;; Return it, why not.
- exp)))
+ (match (tree-il-srcv exp)
+ (#f #t)
+ (#((or #f (? string?)) exact-integer? exact-integer?) #t)
+ (src (error "bad src" src)))
+ ;; Return it, why not.
+ exp))
diff --git a/module/language/tree-il/letrectify.scm
b/module/language/tree-il/letrectify.scm
index 60d057ffd..0f9c6aa3c 100644
--- a/module/language/tree-il/letrectify.scm
+++ b/module/language/tree-il/letrectify.scm
@@ -1,6 +1,6 @@
;;; transformation of top-level bindings into letrec*
-;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2021,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
@@ -190,7 +190,7 @@
(cons name names) (cons var vars) (cons val vals)
tail))
(_
- (make-letrec (tree-il-src tail) #t
+ (make-letrec (tree-il-srcv tail) #t
(list name) (list var) (list val)
tail))))
diff --git a/module/language/tree-il/peval.scm
b/module/language/tree-il/peval.scm
index 7945fd9b9..8fcff9b6a 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -1,6 +1,6 @@
;;; Tree-IL partial evaluator
-;; Copyright (C) 2011-2014, 2017, 2019, 2020, 2021, 2022 Free Software
Foundation, Inc.
+;; Copyright (C) 2011-2014,2017,2019-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
@@ -110,7 +110,7 @@
"Discard all but the first value of X."
(if (singly-valued-expression? x)
x
- (make-primcall (tree-il-src x) 'values (list x))))
+ (make-primcall (tree-il-srcv 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