set! name (lambda ...) names the lambda
* module/ice-9/psyntax.scm (build-lexical-assignment) (build-global-assignment): Maybe name the RHS. * module/ice-9/psyntax-pp.scm: Regenerated. * module/ice-9/boot-9.scm (catch, with-throw-handler, throw): Rework to use set! instead of define! so that we get names.
This commit is contained in:
parent
ec16eb7847
commit
37620f3f4e
3 changed files with 8364 additions and 8325 deletions
|
|
@ -67,6 +67,7 @@
|
||||||
;; Define catch and with-throw-handler, using some common helper routines and a
|
;; Define catch and with-throw-handler, using some common helper routines and a
|
||||||
;; shared fluid. Hide the helpers in a lexical contour.
|
;; shared fluid. Hide the helpers in a lexical contour.
|
||||||
|
|
||||||
|
(define with-throw-handler #f)
|
||||||
(let ()
|
(let ()
|
||||||
;; Ideally we'd like to be able to give these default values for all threads,
|
;; Ideally we'd like to be able to give these default values for all threads,
|
||||||
;; even threads not created by Guile; but alack, that does not currently seem
|
;; even threads not created by Guile; but alack, that does not currently seem
|
||||||
|
|
@ -118,7 +119,7 @@
|
||||||
(apply prev thrown-k args))))
|
(apply prev thrown-k args))))
|
||||||
(apply prev thrown-k args)))))
|
(apply prev thrown-k args)))))
|
||||||
|
|
||||||
(define! 'catch
|
(set! catch
|
||||||
(lambda* (k thunk handler #:optional pre-unwind-handler)
|
(lambda* (k thunk handler #:optional pre-unwind-handler)
|
||||||
"Invoke @var{thunk} in the dynamic context of @var{handler} for
|
"Invoke @var{thunk} in the dynamic context of @var{handler} for
|
||||||
exceptions matching @var{key}. If thunk throws to the symbol
|
exceptions matching @var{key}. If thunk throws to the symbol
|
||||||
|
|
@ -170,7 +171,7 @@ non-locally, that exit determines the continuation."
|
||||||
(lambda (cont k . args)
|
(lambda (cont k . args)
|
||||||
(apply handler k args))))))
|
(apply handler k args))))))
|
||||||
|
|
||||||
(define! 'with-throw-handler
|
(set! with-throw-handler
|
||||||
(lambda (k thunk pre-unwind-handler)
|
(lambda (k thunk pre-unwind-handler)
|
||||||
"Add @var{handler} to the dynamic context as a throw handler
|
"Add @var{handler} to the dynamic context as a throw handler
|
||||||
for key @var{key}, then invoke @var{thunk}."
|
for key @var{key}, then invoke @var{thunk}."
|
||||||
|
|
@ -182,7 +183,7 @@ for key @var{key}, then invoke @var{thunk}."
|
||||||
(custom-throw-handler #f k pre-unwind-handler)))
|
(custom-throw-handler #f k pre-unwind-handler)))
|
||||||
(thunk))))
|
(thunk))))
|
||||||
|
|
||||||
(define! 'throw
|
(set! throw
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
"Invoke the catch form matching @var{key}, passing @var{args} to the
|
"Invoke the catch form matching @var{key}, passing @var{args} to the
|
||||||
@var{handler}.
|
@var{handler}.
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -377,7 +377,13 @@
|
||||||
(set-source-properties! e s))
|
(set-source-properties! e s))
|
||||||
e)
|
e)
|
||||||
|
|
||||||
;;; output constructors
|
(define (maybe-name-value! name val)
|
||||||
|
(if (lambda? val)
|
||||||
|
(let ((meta (lambda-meta val)))
|
||||||
|
(if (not (assq 'name meta))
|
||||||
|
(set-lambda-meta! val (acons 'name name meta))))))
|
||||||
|
|
||||||
|
;;; output constructors
|
||||||
(define build-void
|
(define build-void
|
||||||
(lambda (source)
|
(lambda (source)
|
||||||
(make-void source)))
|
(make-void source)))
|
||||||
|
|
@ -400,6 +406,7 @@
|
||||||
|
|
||||||
(define build-lexical-assignment
|
(define build-lexical-assignment
|
||||||
(lambda (source name var exp)
|
(lambda (source name var exp)
|
||||||
|
(maybe-name-value! name exp)
|
||||||
(make-lexical-set source name var exp)))
|
(make-lexical-set source name var exp)))
|
||||||
|
|
||||||
;; Before modules are booted, we can't expand into data structures from
|
;; Before modules are booted, we can't expand into data structures from
|
||||||
|
|
@ -438,6 +445,7 @@
|
||||||
|
|
||||||
(define build-global-assignment
|
(define build-global-assignment
|
||||||
(lambda (source var exp mod)
|
(lambda (source var exp mod)
|
||||||
|
(maybe-name-value! var exp)
|
||||||
(analyze-variable
|
(analyze-variable
|
||||||
mod var
|
mod var
|
||||||
(lambda (mod var public?)
|
(lambda (mod var public?)
|
||||||
|
|
@ -445,12 +453,6 @@
|
||||||
(lambda (var)
|
(lambda (var)
|
||||||
(make-toplevel-set source var exp)))))
|
(make-toplevel-set source var exp)))))
|
||||||
|
|
||||||
(define (maybe-name-value! name val)
|
|
||||||
(if (lambda? val)
|
|
||||||
(let ((meta (lambda-meta val)))
|
|
||||||
(if (not (assq 'name meta))
|
|
||||||
(set-lambda-meta! val (acons 'name name meta))))))
|
|
||||||
|
|
||||||
(define build-global-definition
|
(define build-global-definition
|
||||||
(lambda (source var exp)
|
(lambda (source var exp)
|
||||||
(maybe-name-value! var exp)
|
(maybe-name-value! var exp)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue