reindent psyntax.scm

* module/ice-9/psyntax.scm: Reindent.

module/ice-9/psyntax.scm

@@ -156,8 +156,8 @@
   (set-current-module (resolve-module '(guile))))
 
 (let ()
-;;; Private version of and-map that handles multiple lists.
-(define and-map*
+  ;; Private version of and-map that handles multiple lists.
+  (define and-map*
     (lambda (f first . rest)
       (or (null? first)
           (if (null? rest)
@@ -175,7 +175,7 @@
                       (apply f x xr)
                       (and (apply f x xr) (andmap first rest)))))))))
 
-(define-syntax define-expansion-constructors
+  (define-syntax define-expansion-constructors
     (lambda (x)
       (syntax-case x ()
         ((_)
@@ -193,7 +193,7 @@
                            out)))
                #`(begin #,@(reverse out))))))))
 
-(define-syntax define-expansion-accessors
+  (define-syntax define-expansion-accessors
     (lambda (x)
       (syntax-case x ()
         ((_ stem field ...)
@@ -221,7 +221,7 @@
                          (syntax->datum #'(field ...))))
                  (lp (1+ n)))))))))
 
-(define-syntax define-structure
+  (define-syntax define-structure
     (lambda (x)
       (define construct-name
         (lambda (template-identifier . args)
@@ -272,11 +272,11 @@
                    (vector-set! x index update)))
                ...))))))
 
-(let ()
+  (let ()
     (define-expansion-constructors)
     (define-expansion-accessors lambda meta)
 
-;;; hooks to nonportable run-time helpers
+    ;; hooks to nonportable run-time helpers
     (begin
       (define fx+ +)
       (define fx- -)
@@ -327,7 +327,7 @@
             (if (not (assq 'name meta))
                 (set-lambda-meta! val (acons 'name name meta))))))
 
-  ;;; output constructors
+    ;; output constructors
     (define build-void
       (lambda (source)
         (make-void source)))
@@ -493,61 +493,61 @@
          (let ((x e))
            (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
 
-;;; compile-time environments
+    ;; compile-time environments
 
-;;; wrap and environment comprise two level mapping.
-;;;   wrap : id --> label
-;;;   env : label --> <element>
+    ;; wrap and environment comprise two level mapping.
+    ;;   wrap : id --> label
+    ;;   env : label --> <element>
 
-;;; environments are represented in two parts: a lexical part and a global
-;;; part.  The lexical part is a simple list of associations from labels
-;;; to bindings.  The global part is implemented by
-;;; {put,get}-global-definition-hook and associates symbols with
-;;; bindings.
+    ;; environments are represented in two parts: a lexical part and a global
+    ;; part.  The lexical part is a simple list of associations from labels
+    ;; to bindings.  The global part is implemented by
+    ;; {put,get}-global-definition-hook and associates symbols with
+    ;; bindings.
 
-;;; global (assumed global variable) and displaced-lexical (see below)
-;;; do not show up in any environment; instead, they are fabricated by
-;;; lookup when it finds no other bindings.
+    ;; global (assumed global variable) and displaced-lexical (see below)
+    ;; do not show up in any environment; instead, they are fabricated by
+    ;; lookup when it finds no other bindings.
 
-;;; <environment>              ::= ((<label> . <binding>)*)
+    ;; <environment>              ::= ((<label> . <binding>)*)
 
-;;; identifier bindings include a type and a value
+    ;; identifier bindings include a type and a value
 
-;;; <binding> ::= (macro . <procedure>)           macros
-;;;               (core . <procedure>)            core forms
-;;;               (module-ref . <procedure>)      @ or @@
-;;;               (begin)                         begin
-;;;               (define)                        define
-;;;               (define-syntax)                 define-syntax
-;;;               (local-syntax . rec?)           let-syntax/letrec-syntax
-;;;               (eval-when)                     eval-when
-;;;               #'. (<var> . <level>)    pattern variables
-;;;               (global)                        assumed global variable
-;;;               (lexical . <var>)               lexical variables
-;;;               (displaced-lexical)             displaced lexicals
-;;; <level>   ::= <nonnegative integer>
-;;; <var>     ::= variable returned by build-lexical-var
+    ;; <binding> ::= (macro . <procedure>)           macros
+    ;;               (core . <procedure>)            core forms
+    ;;               (module-ref . <procedure>)      @ or @@
+    ;;               (begin)                         begin
+    ;;               (define)                        define
+    ;;               (define-syntax)                 define-syntax
+    ;;               (local-syntax . rec?)           let-syntax/letrec-syntax
+    ;;               (eval-when)                     eval-when
+    ;;               #'. (<var> . <level>)    pattern variables
+    ;;               (global)                        assumed global variable
+    ;;               (lexical . <var>)               lexical variables
+    ;;               (displaced-lexical)             displaced lexicals
+    ;; <level>   ::= <nonnegative integer>
+    ;; <var>     ::= variable returned by build-lexical-var
 
-;;; a macro is a user-defined syntactic-form.  a core is a system-defined
-;;; syntactic form.  begin, define, define-syntax, and eval-when are
-;;; treated specially since they are sensitive to whether the form is
-;;; at top-level and (except for eval-when) can denote valid internal
-;;; definitions.
+    ;; a macro is a user-defined syntactic-form.  a core is a system-defined
+    ;; syntactic form.  begin, define, define-syntax, and eval-when are
+    ;; treated specially since they are sensitive to whether the form is
+    ;; at top-level and (except for eval-when) can denote valid internal
+    ;; definitions.
 
-;;; a pattern variable is a variable introduced by syntax-case and can
-;;; be referenced only within a syntax form.
+    ;; a pattern variable is a variable introduced by syntax-case and can
+    ;; be referenced only within a syntax form.
 
-;;; any identifier for which no top-level syntax definition or local
-;;; binding of any kind has been seen is assumed to be a global
-;;; variable.
+    ;; any identifier for which no top-level syntax definition or local
+    ;; binding of any kind has been seen is assumed to be a global
+    ;; variable.
 
-;;; a lexical variable is a lambda- or letrec-bound variable.
+    ;; a lexical variable is a lambda- or letrec-bound variable.
 
-;;; a displaced-lexical identifier is a lexical identifier removed from
-;;; it's scope by the return of a syntax object containing the identifier.
-;;; a displaced lexical can also appear when a letrec-syntax-bound
-;;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
-;;; a displaced lexical should never occur with properly written macros.
+    ;; a displaced-lexical identifier is a lexical identifier removed from
+    ;; it's scope by the return of a syntax object containing the identifier.
+    ;; a displaced lexical can also appear when a letrec-syntax-bound
+    ;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
+    ;; a displaced lexical should never occur with properly written macros.
 
     (define-syntax make-binding
       (syntax-rules (quote)
@@ -574,9 +574,9 @@
             (extend-var-env (cdr labels) (cdr vars)
                             (cons (cons (car labels) (make-binding 'lexical (car vars))) r)))))
 
-;;; we use a "macros only" environment in expansion of local macro
-;;; definitions so that their definitions can use local macros without
-;;; attempting to use other lexical identifiers.
+    ;; we use a "macros only" environment in expansion of local macro
+    ;; definitions so that their definitions can use local macros without
+    ;; attempting to use other lexical identifiers.
     (define macros-only-env
       (lambda (r)
         (if (null? r)
@@ -603,10 +603,10 @@
         (put-global-definition-hook sym type val)))
 
 
-;;; Conceptually, identifiers are always syntax objects.  Internally,
-;;; however, the wrap is sometimes maintained separately (a source of
-;;; efficiency and confusion), so that symbols are also considered
-;;; identifiers by id?.  Externally, they are always wrapped.
+    ;; Conceptually, identifiers are always syntax objects.  Internally,
+    ;; however, the wrap is sometimes maintained separately (a source of
+    ;; efficiency and confusion), so that symbols are also considered
+    ;; identifiers by id?.  Externally, they are always wrapped.
 
     (define nonsymbol-id?
       (lambda (x)
@@ -636,12 +636,12 @@
              (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
             (values x (wrap-marks w)))))
 
-;;; syntax object wraps
+    ;; syntax object wraps
 
-;;;         <wrap> ::= ((<mark> ...) . (<subst> ...))
-;;;        <subst> ::= <shift> | <subs>
-;;;         <subs> ::= #(<old name> <label> (<mark> ...))
-;;;        <shift> ::= positive fixnum
+    ;;         <wrap> ::= ((<mark> ...) . (<subst> ...))
+    ;;        <subst> ::= <shift> | <subs>
+    ;;         <subs> ::= #(<old name> <label> (<mark> ...))
+    ;;        <shift> ::= positive fixnum
 
     (define make-wrap cons)
     (define wrap-marks car)
@@ -655,8 +655,8 @@
       (syntax-rules ()
         ((_ old new marks) (vector old new marks))))
 
-;;; labels must be comparable with "eq?", have read-write invariance,
-;;; and distinct from symbols.
+    ;; labels must be comparable with "eq?", have read-write invariance,
+    ;; and distinct from symbols.
     (define gen-label
       (lambda () (symbol->string (gensym "i"))))
 
@@ -676,9 +676,9 @@
       (syntax-rules ()
         ((_ w) (memq 'top (wrap-marks w)))))
 
-;;; Marks must be comparable with "eq?" and distinct from pairs and
-;;; the symbol top.  We do not use integers so that marks will remain
-;;; unique even across file compiles.
+    ;; Marks must be comparable with "eq?" and distinct from pairs and
+    ;; the symbol top.  We do not use integers so that marks will remain
+    ;; unique even across file compiles.
 
     (define-syntax the-anti-mark (identifier-syntax #f))
 
@@ -691,8 +691,8 @@
       (syntax-rules ()
         ((_) (gensym "m"))))
 
-;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
-;;; internal definitions, in which the ribcages are built incrementally
+    ;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
+    ;; internal definitions, in which the ribcages are built incrementally
     (define-syntax make-empty-ribcage
       (syntax-rules ()
         ((_) (make-ribcage '() '() '()))))
@@ -709,7 +709,7 @@
         (set-ribcage-labels! ribcage
                              (cons label (ribcage-labels ribcage)))))
 
-;;; make-binding-wrap creates vector-based ribcages
+    ;; make-binding-wrap creates vector-based ribcages
     (define make-binding-wrap
       (lambda (ids labels w)
         (if (null? ids)
@@ -811,17 +811,17 @@
                       id))))))
          (else (syntax-violation 'id-var-name "invalid id" id)))))
 
-;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
-;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
+    ;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
+    ;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
 
     (define free-id=?
       (lambda (i j)
         (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
              (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
 
-;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
-;;; long as the missing portion of the wrap is common to both of the ids
-;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
+    ;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
+    ;; long as the missing portion of the wrap is common to both of the ids
+    ;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
 
     (define bound-id=?
       (lambda (i j)
@@ -832,10 +832,10 @@
                               (wrap-marks (syntax-object-wrap j))))
             (eq? i j))))
 
-;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
-;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
-;;; as long as the missing portion of the wrap is common to all of the
-;;; ids.
+    ;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
+    ;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
+    ;; as long as the missing portion of the wrap is common to all of the
+    ;; ids.
 
     (define valid-bound-ids?
       (lambda (ids)
@@ -845,11 +845,11 @@
                         (all-ids? (cdr ids)))))
              (distinct-bound-ids? ids))))
 
-;;; distinct-bound-ids? expects a list of ids and returns #t if there are
-;;; no duplicates.  It is quadratic on the length of the id list; long
-;;; lists could be sorted to make it more efficient.  distinct-bound-ids?
-;;; may be passed unwrapped (or partially wrapped) ids as long as the
-;;; missing portion of the wrap is common to all of the ids.
+    ;; distinct-bound-ids? expects a list of ids and returns #t if there are
+    ;; no duplicates.  It is quadratic on the length of the id list; long
+    ;; lists could be sorted to make it more efficient.  distinct-bound-ids?
+    ;; may be passed unwrapped (or partially wrapped) ids as long as the
+    ;; missing portion of the wrap is common to all of the ids.
 
     (define distinct-bound-ids?
       (lambda (ids)
@@ -864,7 +864,7 @@
              (or (bound-id=? x (car list))
                  (bound-id-member? x (cdr list))))))
 
-;;; wrapping expressions and identifiers
+    ;; wrapping expressions and identifiers
 
     (define wrap
       (lambda (x w defmod)
@@ -882,7 +882,7 @@
       (lambda (x w s defmod)
         (wrap (decorate-source x s) w defmod)))
 
-;;; expanding
+    ;; expanding
 
     (define chi-sequence
       (lambda (body r w s mod)
@@ -933,41 +933,41 @@
                                                   e (wrap x w #f)))))
                        situations))))))
 
-;;; syntax-type returns six values: type, value, e, w, s, and mod. The
-;;; first two are described in the table below.
-;;;
-;;;    type                   value         explanation
-;;;    -------------------------------------------------------------------
-;;;    core                   procedure     core singleton
-;;;    core-form              procedure     core form
-;;;    module-ref             procedure     @ or @@ singleton
-;;;    lexical                name          lexical variable reference
-;;;    global                 name          global variable reference
-;;;    begin                  none          begin keyword
-;;;    define                 none          define keyword
-;;;    define-syntax          none          define-syntax keyword
-;;;    local-syntax           rec?          letrec-syntax/let-syntax keyword
-;;;    eval-when              none          eval-when keyword
-;;;    syntax                 level         pattern variable
-;;;    displaced-lexical      none          displaced lexical identifier
-;;;    lexical-call           name          call to lexical variable
-;;;    global-call            name          call to global variable
-;;;    call                   none          any other call
-;;;    begin-form             none          begin expression
-;;;    define-form            id            variable definition
-;;;    define-syntax-form     id            syntax definition
-;;;    local-syntax-form      rec?          syntax definition
-;;;    eval-when-form         none          eval-when form
-;;;    constant               none          self-evaluating datum
-;;;    other                  none          anything else
-;;;
-;;; For define-form and define-syntax-form, e is the rhs expression.
-;;; For all others, e is the entire form.  w is the wrap for e.
-;;; s is the source for the entire form. mod is the module for e.
-;;;
-;;; syntax-type expands macros and unwraps as necessary to get to
-;;; one of the forms above.  It also parses define and define-syntax
-;;; forms, although perhaps this should be done by the consumer.
+    ;; syntax-type returns six values: type, value, e, w, s, and mod. The
+    ;; first two are described in the table below.
+    ;;
+    ;;    type                   value         explanation
+    ;;    -------------------------------------------------------------------
+    ;;    core                   procedure     core singleton
+    ;;    core-form              procedure     core form
+    ;;    module-ref             procedure     @ or @@ singleton
+    ;;    lexical                name          lexical variable reference
+    ;;    global                 name          global variable reference
+    ;;    begin                  none          begin keyword
+    ;;    define                 none          define keyword
+    ;;    define-syntax          none          define-syntax keyword
+    ;;    local-syntax           rec?          letrec-syntax/let-syntax keyword
+    ;;    eval-when              none          eval-when keyword
+    ;;    syntax                 level         pattern variable
+    ;;    displaced-lexical      none          displaced lexical identifier
+    ;;    lexical-call           name          call to lexical variable
+    ;;    global-call            name          call to global variable
+    ;;    call                   none          any other call
+    ;;    begin-form             none          begin expression
+    ;;    define-form            id            variable definition
+    ;;    define-syntax-form     id            syntax definition
+    ;;    local-syntax-form      rec?          syntax definition
+    ;;    eval-when-form         none          eval-when form
+    ;;    constant               none          self-evaluating datum
+    ;;    other                  none          anything else
+    ;;
+    ;; For define-form and define-syntax-form, e is the rhs expression.
+    ;; For all others, e is the entire form.  w is the wrap for e.
+    ;; s is the source for the entire form. mod is the module for e.
+    ;;
+    ;; syntax-type expands macros and unwraps as necessary to get to
+    ;; one of the forms above.  It also parses define and define-syntax
+    ;; forms, although perhaps this should be done by the consumer.
 
     (define syntax-type
       (lambda (e r w s rib mod for-car?)
@@ -1678,13 +1678,13 @@
                         (build-lambda-case s req opt rest kw inits vars
                                            body else*))))))))))))
 
-;;; data
+    ;; data
 
-;;; strips syntax-objects down to top-wrap
-;;;
-;;; since only the head of a list is annotated by the reader, not each pair
-;;; in the spine, we also check for pairs whose cars are annotated in case
-;;; we've been passed the cdr of an annotated list
+    ;; strips syntax-objects down to top-wrap
+    ;;
+    ;; since only the head of a list is annotated by the reader, not each pair
+    ;; in the spine, we also check for pairs whose cars are annotated in case
+    ;; we've been passed the cdr of an annotated list
 
     (define strip
       (lambda (x w)
@@ -1705,7 +1705,7 @@
                     (if (and-map* eq? old new) x (list->vector new)))))
                (else x))))))
 
-;;; lexical variables
+    ;; lexical variables
 
     (define gen-var
       (lambda (id)
@@ -1728,7 +1728,7 @@
            ;; checking
            (else (cons vars ls))))))
 
-;;; core transformers
+    ;; core transformers
 
     (global-extend 'local-syntax 'letrec-syntax #t)
     (global-extend 'local-syntax 'let-syntax #f)
@@ -2361,15 +2361,15 @@
                                                      (list (chi #'val r empty-wrap mod))))
                                 (syntax-violation 'syntax-case "invalid literals list" e))))))))
 
-;;; The portable macroexpand seeds chi-top's mode m with 'e (for
-;;; evaluating) and esew (which stands for "eval syntax expanders
-;;; when") with '(eval).  In Chez Scheme, m is set to 'c instead of e
-;;; if we are compiling a file, and esew is set to
-;;; (eval-syntactic-expanders-when), which defaults to the list
-;;; '(compile load eval).  This means that, by default, top-level
-;;; syntactic definitions are evaluated immediately after they are
-;;; expanded, and the expanded definitions are also residualized into
-;;; the object file if we are compiling a file.
+    ;; The portable macroexpand seeds chi-top's mode m with 'e (for
+    ;; evaluating) and esew (which stands for "eval syntax expanders
+    ;; when") with '(eval).  In Chez Scheme, m is set to 'c instead of e
+    ;; if we are compiling a file, and esew is set to
+    ;; (eval-syntactic-expanders-when), which defaults to the list
+    ;; '(compile load eval).  This means that, by default, top-level
+    ;; syntactic definitions are evaluated immediately after they are
+    ;; expanded, and the expanded definitions are also residualized into
+    ;; the object file if we are compiling a file.
     (set! macroexpand
           (lambda* (x #:optional (m 'e) (esew '(eval)))
             (chi-top x null-env top-wrap m esew
@@ -2426,28 +2426,28 @@
                          (if who (cons who tail) tail))
                        #f)))
 
-;;; $sc-dispatch expects an expression and a pattern.  If the expression
-;;; matches the pattern a list of the matching expressions for each
-;;; "any" is returned.  Otherwise, #f is returned.  (This use of #f will
-;;; not work on r4rs implementations that violate the ieee requirement
-;;; that #f and () be distinct.)
+    ;; $sc-dispatch expects an expression and a pattern.  If the expression
+    ;; matches the pattern a list of the matching expressions for each
+    ;; "any" is returned.  Otherwise, #f is returned.  (This use of #f will
+    ;; not work on r4rs implementations that violate the ieee requirement
+    ;; that #f and () be distinct.)
 
-;;; The expression is matched with the pattern as follows:
+    ;; The expression is matched with the pattern as follows:
 
-;;; pattern:                           matches:
-;;;   ()                                 empty list
-;;;   any                                anything
-;;;   (<pattern>1 . <pattern>2)          (<pattern>1 . <pattern>2)
-;;;   each-any                           (any*)
-;;;   #(free-id <key>)                   <key> with free-identifier=?
-;;;   #(each <pattern>)                  (<pattern>*)
-;;;   #(each+ p1 (p2_1 ... p2_n) p3)      (p1* (p2_n ... p2_1) . p3)
-;;;   #(vector <pattern>)                (list->vector <pattern>)
-;;;   #(atom <object>)                   <object> with "equal?"
+    ;; pattern:                           matches:
+    ;;   ()                                 empty list
+    ;;   any                                anything
+    ;;   (<pattern>1 . <pattern>2)          (<pattern>1 . <pattern>2)
+    ;;   each-any                           (any*)
+    ;;   #(free-id <key>)                   <key> with free-identifier=?
+    ;;   #(each <pattern>)                  (<pattern>*)
+    ;;   #(each+ p1 (p2_1 ... p2_n) p3)      (p1* (p2_n ... p2_1) . p3)
+    ;;   #(vector <pattern>)                (list->vector <pattern>)
+    ;;   #(atom <object>)                   <object> with "equal?"
 
-;;; Vector cops out to pair under assumption that vectors are rare.  If
-;;; not, should convert to:
-;;;   #(vector <pattern>*)               #(<pattern>*)
+    ;; Vector cops out to pair under assumption that vectors are rare.  If
+    ;; not, should convert to:
+    ;;   #(vector <pattern>*)               #(<pattern>*)
 
     (let ()
 
@@ -2587,10 +2587,8 @@
                ((syntax-object? e)
                 (match* (syntax-object-expression e)
                         p (syntax-object-wrap e) '() (syntax-object-module e)))
-             (else (match* e p empty-wrap '() #f)))))
+               (else (match* e p empty-wrap '() #f))))))))
 
-    ))
-)
 
 (define-syntax with-syntax
    (lambda (x)