1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

peval: Indenting. NFC.

* module/language/tree-il/peval.scm (peval): Reindent.
This commit is contained in:
Andy Wingo 2024-03-13 20:28:43 +01:00
parent f95bf6921e
commit 17e8d7530f

View file

@ -580,15 +580,15 @@ top-level bindings from ENV and return the resulting expression."
(define (apply-primitive name args)
;; todo: further optimize commutative primitives
(catch #t
(lambda ()
(define mod (resolve-interface (primitive-module name)))
(call-with-values
(lambda ()
(apply (module-ref mod name) args))
(lambda results
(values #t results))))
(lambda _
(values #f '()))))
(lambda ()
(define mod (resolve-interface (primitive-module name)))
(call-with-values
(lambda ()
(apply (module-ref mod name) args))
(lambda results
(values #t results))))
(lambda _
(values #f '()))))
(define (make-values src values)
(match values
((single) single) ; 1 value
@ -1307,22 +1307,22 @@ top-level bindings from ENV and return the resulting expression."
(($ <primcall> src 'values exps)
(match exps
(()
(case ctx
((effect) (make-void #f))
((values) exp)
;; Zero values returned to continuation expecting a value:
;; ensure that we raise an error.
(else (make-primcall src 'values (list exp)))))
((($ <primcall> _ 'values ())) exp)
(_
(let ((vals (map for-value exps)))
(if (and (case ctx
((value test effect) #t)
(else (null? (cdr vals))))
(every singly-valued-expression? vals))
(for-tail (list->seq src (append (cdr vals) (list (car vals)))))
(make-primcall src 'values vals))))))
(()
(case ctx
((effect) (make-void #f))
((values) exp)
;; Zero values returned to continuation expecting a value:
;; ensure that we raise an error.
(else (make-primcall src 'values (list exp)))))
((($ <primcall> _ 'values ())) exp)
(_
(let ((vals (map for-value exps)))
(if (and (case ctx
((value test effect) #t)
(else (null? (cdr vals))))
(every singly-valued-expression? vals))
(for-tail (list->seq src (append (cdr vals) (list (car vals)))))
(make-primcall src 'values vals))))))
(($ <primcall> src 'apply (proc args ... tail))
(let lp ((tail* (find-definition tail 1)) (speculative? #t))