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

peval: Indenting. NFC.

Browse source 
* 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
1 changed files with 25 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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