mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Use tree-il-srcv instead of tree-il-src

Browse source 
This prevents eager conversion to alists.
This commit is contained in:
Andy Wingo 2023-03-28 16:10:38 +02:00
parent b0a390db06
commit 2cd8b4160c
8 changed files with 32 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/cps/dump.scm
View file

@ -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
(match src
(#f #f)
(#(filename line column)
(format #f "~a:~a:~a"
(or (assq-ref src 'filename) "<unknown>")
(1+ (assq-ref src 'line))
(assq-ref src 'column))))
(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)

3
module/language/tree-il.scm
View file

@ -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

8
module/language/tree-il/analyze.scm
View file

@ -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?

4
module/language/tree-il/compile-bytecode.scm
View file

@ -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 '())

10
module/language/tree-il/compile-cps.scm
View file

@ -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))))))))

12
module/language/tree-il/debug.scm
View file

@ -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"))
(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)))
exp))

4
module/language/tree-il/letrectify.scm
View file

@ -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))))

4
module/language/tree-il/peval.scm
View file

@ -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