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

Remove trailing whitespace

* module/language/tree-il.scm: Remove trailing whitespace
This commit is contained in:
No Itisnt 2010-07-09 21:22:27 -05:00
parent ffe911f714
commit d26a26f6c0

View file

@ -1,19 +1,19 @@
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010 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
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either ;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version. ;;;; version 3 of the License, or (at your option) any later version.
;;;; ;;;;
;;;; This library is distributed in the hope that it will be useful, ;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details. ;;;; Lesser General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU Lesser General Public ;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software ;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; ;;;;
(define-module (language tree-il) (define-module (language tree-il)
@ -47,7 +47,7 @@
<let-values> let-values? make-let-values let-values-src let-values-exp let-values-body <let-values> let-values? make-let-values let-values-src let-values-exp let-values-body
<dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder
<dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body <dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body
<dynref> dynref? make-dynref dynref-src dynref-fluid <dynref> dynref? make-dynref dynref-src dynref-fluid
<dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp <dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp
<prompt> prompt? make-prompt prompt-src prompt-tag prompt-body prompt-handler <prompt> prompt? make-prompt prompt-src prompt-tag prompt-body prompt-handler
<abort> abort? make-abort abort-src abort-tag abort-args abort-tail <abort> abort? make-abort abort-src abort-tag abort-args abort-tail
@ -134,7 +134,7 @@
(<dynset> fluid exp) (<dynset> fluid exp)
(<prompt> tag body handler) (<prompt> tag body handler)
(<abort> tag args tail)) (<abort> tag args tail))
(define (location x) (define (location x)
@ -195,7 +195,7 @@
(make-lambda loc meta (retrans body))) (make-lambda loc meta (retrans body)))
((lambda-case ((,req ,opt ,rest ,kw ,inits ,gensyms) ,body) ,alternate) ((lambda-case ((,req ,opt ,rest ,kw ,inits ,gensyms) ,body) ,alternate)
(make-lambda-case loc req opt rest kw (make-lambda-case loc req opt rest kw
(map retrans inits) gensyms (map retrans inits) gensyms
(retrans body) (retrans body)
(and=> alternate retrans))) (and=> alternate retrans)))
@ -229,19 +229,19 @@
((dynwind ,winder ,body ,unwinder) ((dynwind ,winder ,body ,unwinder)
(make-dynwind loc (retrans winder) (retrans body) (retrans unwinder))) (make-dynwind loc (retrans winder) (retrans body) (retrans unwinder)))
((dynlet ,fluids ,vals ,body) ((dynlet ,fluids ,vals ,body)
(make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body))) (make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body)))
((dynref ,fluid) ((dynref ,fluid)
(make-dynref loc (retrans fluid))) (make-dynref loc (retrans fluid)))
((dynset ,fluid ,exp) ((dynset ,fluid ,exp)
(make-dynset loc (retrans fluid) (retrans exp))) (make-dynset loc (retrans fluid) (retrans exp)))
((prompt ,tag ,body ,handler) ((prompt ,tag ,body ,handler)
(make-prompt loc (retrans tag) (retrans body) (retrans handler))) (make-prompt loc (retrans tag) (retrans body) (retrans handler)))
((abort ,tag ,args ,tail) ((abort ,tag ,args ,tail)
(make-abort loc (retrans tag) (map retrans args) (retrans tail))) (make-abort loc (retrans tag) (map retrans args) (retrans tail)))
@ -313,20 +313,20 @@
((<dynwind> body winder unwinder) ((<dynwind> body winder unwinder)
`(dynwind ,(unparse-tree-il body) `(dynwind ,(unparse-tree-il body)
,(unparse-tree-il winder) ,(unparse-tree-il unwinder))) ,(unparse-tree-il winder) ,(unparse-tree-il unwinder)))
((<dynlet> fluids vals body) ((<dynlet> fluids vals body)
`(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals) `(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals)
,(unparse-tree-il body))) ,(unparse-tree-il body)))
((<dynref> fluid) ((<dynref> fluid)
`(dynref ,(unparse-tree-il fluid))) `(dynref ,(unparse-tree-il fluid)))
((<dynset> fluid exp) ((<dynset> fluid exp)
`(dynref ,(unparse-tree-il fluid) ,(unparse-tree-il exp))) `(dynref ,(unparse-tree-il fluid) ,(unparse-tree-il exp)))
((<prompt> tag body handler) ((<prompt> tag body handler)
`(prompt ,(unparse-tree-il tag) ,(unparse-tree-il body) ,(unparse-tree-il handler))) `(prompt ,(unparse-tree-il tag) ,(unparse-tree-il body) ,(unparse-tree-il handler)))
((<abort> tag args tail) ((<abort> tag args tail)
`(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args) `(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args)
,(unparse-tree-il tail))))) ,(unparse-tree-il tail)))))
@ -346,32 +346,32 @@
((<primitive-ref> name) ((<primitive-ref> name)
name) name)
((<lexical-ref> gensym) ((<lexical-ref> gensym)
gensym) gensym)
((<lexical-set> gensym exp) ((<lexical-set> gensym exp)
`(set! ,gensym ,(tree-il->scheme exp))) `(set! ,gensym ,(tree-il->scheme exp)))
((<module-ref> mod name public?) ((<module-ref> mod name public?)
`(,(if public? '@ '@@) ,mod ,name)) `(,(if public? '@ '@@) ,mod ,name))
((<module-set> mod name public? exp) ((<module-set> mod name public? exp)
`(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp))) `(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp)))
((<toplevel-ref> name) ((<toplevel-ref> name)
name) name)
((<toplevel-set> name exp) ((<toplevel-set> name exp)
`(set! ,name ,(tree-il->scheme exp))) `(set! ,name ,(tree-il->scheme exp)))
((<toplevel-define> name exp) ((<toplevel-define> name exp)
`(define ,name ,(tree-il->scheme exp))) `(define ,name ,(tree-il->scheme exp)))
((<lambda> meta body) ((<lambda> meta body)
;; fixme: put in docstring ;; fixme: put in docstring
(tree-il->scheme body)) (tree-il->scheme body))
((<lambda-case> req opt rest kw inits gensyms body alternate) ((<lambda-case> req opt rest kw inits gensyms body alternate)
(cond (cond
((and (not opt) (not kw) (not alternate)) ((and (not opt) (not kw) (not alternate))
@ -400,7 +400,7 @@
(restargs (if rest (list-ref gensyms (+ nreq nopt)) '())) (restargs (if rest (list-ref gensyms (+ nreq nopt)) '()))
(reqargs (list-head gensyms nreq)) (reqargs (list-head gensyms nreq))
(optargs (if opt (optargs (if opt
`(#:optional `(#:optional
,@(map list ,@(map list
(list-head (list-tail gensyms nreq) nopt) (list-head (list-tail gensyms nreq) nopt)
(map tree-il->scheme (map tree-il->scheme
@ -432,13 +432,13 @@
(if (and (self-evaluating? exp) (not (vector? exp))) (if (and (self-evaluating? exp) (not (vector? exp)))
exp exp
(list 'quote exp))) (list 'quote exp)))
((<sequence> exps) ((<sequence> exps)
`(begin ,@(map tree-il->scheme exps))) `(begin ,@(map tree-il->scheme exps)))
((<let> gensyms vals body) ((<let> gensyms vals body)
`(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) `(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body)))
((<letrec> in-order? gensyms vals body) ((<letrec> in-order? gensyms vals body)
`(,(if in-order? 'letrec* 'letrec) `(,(if in-order? 'letrec* 'letrec)
,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body))) ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body)))
@ -457,24 +457,24 @@
`(dynamic-wind ,(tree-il->scheme winder) `(dynamic-wind ,(tree-il->scheme winder)
(lambda () ,(tree-il->scheme body)) (lambda () ,(tree-il->scheme body))
,(tree-il->scheme unwinder))) ,(tree-il->scheme unwinder)))
((<dynlet> fluids vals body) ((<dynlet> fluids vals body)
`(with-fluids ,(map list `(with-fluids ,(map list
(map tree-il->scheme fluids) (map tree-il->scheme fluids)
(map tree-il->scheme vals)) (map tree-il->scheme vals))
,(tree-il->scheme body))) ,(tree-il->scheme body)))
((<dynref> fluid) ((<dynref> fluid)
`(fluid-ref ,(tree-il->scheme fluid))) `(fluid-ref ,(tree-il->scheme fluid)))
((<dynset> fluid exp) ((<dynset> fluid exp)
`(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp))) `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp)))
((<prompt> tag body handler) ((<prompt> tag body handler)
`((@ (ice-9 control) prompt) `((@ (ice-9 control) prompt)
,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body)) ,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body))
,(tree-il->scheme handler))) ,(tree-il->scheme handler)))
((<abort> tag args tail) ((<abort> tag args tail)
`(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args) `(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args)
@ -640,76 +640,76 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (conditional-test x) (lp test)) (set! (conditional-test x) (lp test))
(set! (conditional-consequent x) (lp consequent)) (set! (conditional-consequent x) (lp consequent))
(set! (conditional-alternate x) (lp alternate))) (set! (conditional-alternate x) (lp alternate)))
((<lexical-set> name gensym exp) ((<lexical-set> name gensym exp)
(set! (lexical-set-exp x) (lp exp))) (set! (lexical-set-exp x) (lp exp)))
((<module-set> mod name public? exp) ((<module-set> mod name public? exp)
(set! (module-set-exp x) (lp exp))) (set! (module-set-exp x) (lp exp)))
((<toplevel-set> name exp) ((<toplevel-set> name exp)
(set! (toplevel-set-exp x) (lp exp))) (set! (toplevel-set-exp x) (lp exp)))
((<toplevel-define> name exp) ((<toplevel-define> name exp)
(set! (toplevel-define-exp x) (lp exp))) (set! (toplevel-define-exp x) (lp exp)))
((<lambda> body) ((<lambda> body)
(set! (lambda-body x) (lp body))) (set! (lambda-body x) (lp body)))
((<lambda-case> inits body alternate) ((<lambda-case> inits body alternate)
(set! inits (map lp inits)) (set! inits (map lp inits))
(set! (lambda-case-body x) (lp body)) (set! (lambda-case-body x) (lp body))
(if alternate (if alternate
(set! (lambda-case-alternate x) (lp alternate)))) (set! (lambda-case-alternate x) (lp alternate))))
((<sequence> exps) ((<sequence> exps)
(set! (sequence-exps x) (map lp exps))) (set! (sequence-exps x) (map lp exps)))
((<let> gensyms vals body) ((<let> gensyms vals body)
(set! (let-vals x) (map lp vals)) (set! (let-vals x) (map lp vals))
(set! (let-body x) (lp body))) (set! (let-body x) (lp body)))
((<letrec> gensyms vals body) ((<letrec> gensyms vals body)
(set! (letrec-vals x) (map lp vals)) (set! (letrec-vals x) (map lp vals))
(set! (letrec-body x) (lp body))) (set! (letrec-body x) (lp body)))
((<fix> gensyms vals body) ((<fix> gensyms vals body)
(set! (fix-vals x) (map lp vals)) (set! (fix-vals x) (map lp vals))
(set! (fix-body x) (lp body))) (set! (fix-body x) (lp body)))
((<let-values> exp body) ((<let-values> exp body)
(set! (let-values-exp x) (lp exp)) (set! (let-values-exp x) (lp exp))
(set! (let-values-body x) (lp body))) (set! (let-values-body x) (lp body)))
((<dynwind> body winder unwinder) ((<dynwind> body winder unwinder)
(set! (dynwind-body x) (lp body)) (set! (dynwind-body x) (lp body))
(set! (dynwind-winder x) (lp winder)) (set! (dynwind-winder x) (lp winder))
(set! (dynwind-unwinder x) (lp unwinder))) (set! (dynwind-unwinder x) (lp unwinder)))
((<dynlet> fluids vals body) ((<dynlet> fluids vals body)
(set! (dynlet-fluids x) (map lp fluids)) (set! (dynlet-fluids x) (map lp fluids))
(set! (dynlet-vals x) (map lp vals)) (set! (dynlet-vals x) (map lp vals))
(set! (dynlet-body x) (lp body))) (set! (dynlet-body x) (lp body)))
((<dynref> fluid) ((<dynref> fluid)
(set! (dynref-fluid x) (lp fluid))) (set! (dynref-fluid x) (lp fluid)))
((<dynset> fluid exp) ((<dynset> fluid exp)
(set! (dynset-fluid x) (lp fluid)) (set! (dynset-fluid x) (lp fluid))
(set! (dynset-exp x) (lp exp))) (set! (dynset-exp x) (lp exp)))
((<prompt> tag body handler) ((<prompt> tag body handler)
(set! (prompt-tag x) (lp tag)) (set! (prompt-tag x) (lp tag))
(set! (prompt-body x) (lp body)) (set! (prompt-body x) (lp body))
(set! (prompt-handler x) (lp handler))) (set! (prompt-handler x) (lp handler)))
((<abort> tag args tail) ((<abort> tag args tail)
(set! (abort-tag x) (lp tag)) (set! (abort-tag x) (lp tag))
(set! (abort-args x) (map lp args)) (set! (abort-args x) (map lp args))
(set! (abort-tail x) (lp tail))) (set! (abort-tail x) (lp tail)))
(else #f)) (else #f))
(or (f x) x))) (or (f x) x)))
(define (pre-order! f x) (define (pre-order! f x)
@ -727,7 +727,7 @@ This is an implementation of `foldts' as described by Andy Wingo in
((<lexical-set> exp) ((<lexical-set> exp)
(set! (lexical-set-exp x) (lp exp))) (set! (lexical-set-exp x) (lp exp)))
((<module-set> exp) ((<module-set> exp)
(set! (module-set-exp x) (lp exp))) (set! (module-set-exp x) (lp exp)))
@ -768,28 +768,28 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (dynwind-body x) (lp body)) (set! (dynwind-body x) (lp body))
(set! (dynwind-winder x) (lp winder)) (set! (dynwind-winder x) (lp winder))
(set! (dynwind-unwinder x) (lp unwinder))) (set! (dynwind-unwinder x) (lp unwinder)))
((<dynlet> fluids vals body) ((<dynlet> fluids vals body)
(set! (dynlet-fluids x) (map lp fluids)) (set! (dynlet-fluids x) (map lp fluids))
(set! (dynlet-vals x) (map lp vals)) (set! (dynlet-vals x) (map lp vals))
(set! (dynlet-body x) (lp body))) (set! (dynlet-body x) (lp body)))
((<dynref> fluid) ((<dynref> fluid)
(set! (dynref-fluid x) (lp fluid))) (set! (dynref-fluid x) (lp fluid)))
((<dynset> fluid exp) ((<dynset> fluid exp)
(set! (dynset-fluid x) (lp fluid)) (set! (dynset-fluid x) (lp fluid))
(set! (dynset-exp x) (lp exp))) (set! (dynset-exp x) (lp exp)))
((<prompt> tag body handler) ((<prompt> tag body handler)
(set! (prompt-tag x) (lp tag)) (set! (prompt-tag x) (lp tag))
(set! (prompt-body x) (lp body)) (set! (prompt-body x) (lp body))
(set! (prompt-handler x) (lp handler))) (set! (prompt-handler x) (lp handler)))
((<abort> tag args tail) ((<abort> tag args tail)
(set! (abort-tag x) (lp tag)) (set! (abort-tag x) (lp tag))
(set! (abort-args x) (map lp args)) (set! (abort-args x) (map lp args))
(set! (abort-tail x) (lp tail))) (set! (abort-tail x) (lp tail)))
(else #f)) (else #f))
x))) x)))