diff options
author | Andy Wingo <wingo@pobox.com> | 2023-03-28 16:10:38 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-06-19 13:53:01 +0200 |
commit | 2cd8b4160c4f8b2f3b590f29f82c64dd4a1e2290 (patch) | |
tree | ac5358be82342506ec7236fcfdceb74dda873515 /module/language/tree-il | |
parent | b0a390db065961f8b2c1ebecb1299cfc0dacfda3 (diff) | |
download | guile-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.scm | 8 | ||||
-rw-r--r-- | module/language/tree-il/compile-bytecode.scm | 4 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 10 | ||||
-rw-r--r-- | module/language/tree-il/debug.scm | 14 | ||||
-rw-r--r-- | module/language/tree-il/letrectify.scm | 4 | ||||
-rw-r--r-- | module/language/tree-il/peval.scm | 4 |
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 |