mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

define-inlinable marks residualized procedure as maybe-unused

Browse source 
* module/ice-9/boot-9.scm (define-inlinable):
* module/srfi/srfi-9.scm (define-tagged-inlinable): Add maybe-unused
declaration.  Also require at least one body expr, otherwise the
metadata declaration could escape as the proc body.
This commit is contained in:
Andy Wingo 2023-08-24 11:41:15 +02:00
parent 1f70d597db
commit 19c7969fff
2 changed files with 9 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/ice-9/boot-9.scm
View file

@ -4608,21 +4608,22 @@ when none is available, reading FILE-NAME with READER."
'-procedure))) '-procedure)))
(syntax-case x () (syntax-case x ()
((_ (name formals ...) body ...) ((_ (name formals ...) body0 body ...)
(identifier? #'name) (identifier? #'name)
(with-syntax ((proc-name (make-procedure-name #'name)) (with-syntax ((proc-name (make-procedure-name #'name))
((args ...) (generate-temporaries #'(formals ...)))) ((args ...) (generate-temporaries #'(formals ...))))
#`(begin #`(begin
(define (proc-name formals ...) (define (proc-name formals ...)
#((maybe-unused))
(syntax-parameterize ((name (identifier-syntax proc-name))) (syntax-parameterize ((name (identifier-syntax proc-name)))
body ...)) body0 body ...))
(define-syntax-parameter name (define-syntax-parameter name
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ args ...) ((_ args ...)
#'((syntax-parameterize ((name (identifier-syntax proc-name))) #'((syntax-parameterize ((name (identifier-syntax proc-name)))
(lambda (formals ...) (lambda (formals ...)
body ...)) body0 body ...))
args ...)) args ...))
((_ a (... ...)) ((_ a (... ...))
(syntax-violation 'name "Wrong number of arguments" x)) (syntax-violation 'name "Wrong number of arguments" x))

9
module/srfi/srfi-9.scm
View file

@ -1,6 +1,6 @@
;;; srfi-9.scm --- define-record-type ;;; srfi-9.scm --- define-record-type
;; Copyright (C) 2001-2002, 2006, 2008-2014, 2018-2019 ;; Copyright (C) 2001-2002, 2006, 2008-2014, 2018-2019, 2023
;; Free Software Foundation, Inc. ;; Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
@ -108,20 +108,21 @@
'-procedure))) '-procedure)))
(syntax-case x () (syntax-case x ()
((_ ((key value) ...) (name formals ...) body ...) ((_ ((key value) ...) (name formals ...) body0 body ...)
(identifier? #'name) (identifier? #'name)
(with-syntax ((proc-name (make-procedure-name #'name)) (with-syntax ((proc-name (make-procedure-name #'name))
((args ...) (generate-temporaries #'(formals ...)))) ((args ...) (generate-temporaries #'(formals ...))))
#`(begin #`(begin
(define (proc-name formals ...) (define (proc-name formals ...)
body ...) #((maybe-unused))
body0 body ...)
(define-syntax name (define-syntax name
(lambda (x) (lambda (x)
(syntax-case x (%%on-error key ...) (syntax-case x (%%on-error key ...)
((_ (%%on-error err) key s) #'(ck s 'value)) ... ((_ (%%on-error err) key s) #'(ck s 'value)) ...
((_ args ...) ((_ args ...)
#'((lambda (formals ...) #'((lambda (formals ...)
body ...) body0 body ...)
args ...)) args ...))
((_ a (... ...)) ((_ a (... ...))
(syntax-violation 'name "Wrong number of arguments" x)) (syntax-violation 'name "Wrong number of arguments" x))