summaryrefslogtreecommitdiff
path: root/module/language/tree-il
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-03-28 16:10:38 +0200
committerAndy Wingo <wingo@pobox.com>2023-06-19 13:53:01 +0200
commit2cd8b4160c4f8b2f3b590f29f82c64dd4a1e2290 (patch)
treeac5358be82342506ec7236fcfdceb74dda873515 /module/language/tree-il
parentb0a390db065961f8b2c1ebecb1299cfc0dacfda3 (diff)
downloadguile-2cd8b4160c4f8b2f3b590f29f82c64dd4a1e2290.tar.gz
Use tree-il-srcv instead of tree-il-src
This prevents eager conversion to alists.
Diffstat (limited to 'module/language/tree-il')
-rw-r--r--module/language/tree-il/analyze.scm8
-rw-r--r--module/language/tree-il/compile-bytecode.scm4
-rw-r--r--module/language/tree-il/compile-cps.scm10
-rw-r--r--module/language/tree-il/debug.scm14
-rw-r--r--module/language/tree-il/letrectify.scm4
-rw-r--r--module/language/tree-il/peval.scm4
6 files changed, 22 insertions, 22 deletions
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index c2d1f992e..c949b5f54 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))
@@ -499,7 +499,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))))
@@ -900,7 +900,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 36a3033b0..baf4f5847 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