|
| From: | Mark H Weaver |
| Subject: | [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-72-g1af6d2a |
| Date: | Sat, 03 Mar 2012 23:09:28 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1af6d2a717f499564fbbc297c79e00ac14b0dcf9
The branch, stable-2.0 has been updated
via 1af6d2a717f499564fbbc297c79e00ac14b0dcf9 (commit)
via 72ee0ef71b9a0514874976cdcf3ea9d5333db4b1 (commit)
via 8c43b28a1136aba186fd211b0f6037cf0c35f006 (commit)
from 9120f130a8ccd237d31806f381a1a1a25f5d930a (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 1af6d2a717f499564fbbc297c79e00ac14b0dcf9
Author: Mark H Weaver <address@hidden>
Date: Fri Mar 2 18:40:43 2012 -0500
Minimize size of embedded syntax objects in psyntax-pp.scm
* module/ice-9/compile-psyntax.scm: Minimize syntax object literals
embedded in psyntax-pp.scm.
* module/ice-9/psyntax.scm: Rename a few variables so that syntax
objects embedded in macros have no lexical bindings, so that their
minimized syntax objects will have no embedded labels. These labels
were the last remaining gensym counters in psyntax-pp.scm.
* module/ice-9/psyntax-pp.scm: Regenerate. It is now less than one
quarter of its previous size! More importantly, this file no longer
contains any gensym counters, which means that in the future, local
changes to psyntax.scm will usually result in only local changes to
psyntax-pp.scm.
commit 72ee0ef71b9a0514874976cdcf3ea9d5333db4b1
Author: Mark H Weaver <address@hidden>
Date: Thu Mar 1 17:56:14 2012 -0500
tree-il->scheme improvements
* module/language/tree-il.scm (tree-il->scheme): New implementation that
simply calls 'decompile-tree-il'.
* module/language/scheme/decompile-tree-il.scm (choose-output-names,
do-decompile): New internal procedures.
(decompile-tree-il): New and improved implementation. Print source
identifiers where possible, otherwise add minimal numeric suffixes.
Previously we printed the gensyms. Avoid 'begin' in contexts that
provide an implicit 'begin'. Produce 'cond', 'case', 'and', 'or',
'let*', named let, and internal defines where appropriate. Recognize
keyword arguments in 'opts' to disable the production of these derived
syntactic forms, and to optionally strip numeric suffixes from
variable names.
* module/ice-9/compile-psyntax.scm: Disable partial evaluation, letrec
fixing, and primitive expansion when producing psyntax-pp.scm, in
order to produce output as close to the original source as practical.
Disable production of derived syntactic forms as needed during
bootstrap. Strip numeric suffixes from variable names. Adjust
pretty-printing parameters.
* module/ice-9/psyntax-pp.scm: Regenerate. It is now less than half
of the original size.
commit 8c43b28a1136aba186fd211b0f6037cf0c35f006
Author: Mark H Weaver <address@hidden>
Date: Sun Feb 26 15:58:30 2012 -0500
pretty-print: allow max-expr-width to be set; recognize more keywords
* module/ice-9/pretty-print.scm (pretty-print): Add new keyword argument
'#:max-expr-width'.
(generic-write): Add new argument 'max-expr-width'. Previously this
was internally defined to the constant value 50.
-----------------------------------------------------------------------
Summary of changes:
module/ice-9/compile-psyntax.scm | 80 +-
module/ice-9/pretty-print.scm | 16 +-
module/ice-9/psyntax-pp.scm |29904 +++-----------------------
module/ice-9/psyntax.scm | 8 +-
module/language/scheme/decompile-tree-il.scm | 795 +-
module/language/tree-il.scm | 155 +-
6 files changed, 4022 insertions(+), 26936 deletions(-)
diff --git a/module/ice-9/compile-psyntax.scm b/module/ice-9/compile-psyntax.scm
index 3d803e9..201ae39 100644
--- a/module/ice-9/compile-psyntax.scm
+++ b/module/ice-9/compile-psyntax.scm
@@ -17,11 +17,70 @@
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
(use-modules (language tree-il)
- (language tree-il optimize)
+ (language tree-il primitives)
(language tree-il canonicalize)
+ (srfi srfi-1)
(ice-9 pretty-print)
(system syntax))
+;; Minimize a syntax-object such that it can no longer be used as the
+;; first argument to 'datum->syntax', but is otherwise equivalent.
+(define (squeeze-syntax-object! syn)
+ (define (ensure-list x) (if (vector? x) (vector->list x) x))
+ (let ((x (vector-ref syn 1))
+ (wrap (vector-ref syn 2))
+ (mod (vector-ref syn 3)))
+ (let ((marks (car wrap))
+ (subst (cdr wrap)))
+ (define (set-wrap! marks subst)
+ (vector-set! syn 2 (cons marks subst)))
+ (cond
+ ((symbol? x)
+ (let loop ((marks marks) (subst subst))
+ (cond
+ ((null? subst) (set-wrap! marks subst) syn)
+ ((eq? 'shift (car subst)) (loop (cdr marks) (cdr subst)))
+ ((find (lambda (entry) (and (eq? x (car entry))
+ (equal? marks (cadr entry))))
+ (apply map list (map ensure-list
+ (cdr (vector->list (car subst))))))
+ => (lambda (entry)
+ (set-wrap! marks
+ (list (list->vector
+ (cons 'ribcage
+ (map vector entry)))))
+ syn))
+ (else (loop marks (cdr subst))))))
+ ((or (pair? x) (vector? x))
+ syn)
+ (else x)))))
+
+(define (squeeze-constant! x)
+ (define (syntax-object? x)
+ (and (vector? x)
+ (= 4 (vector-length x))
+ (eq? 'syntax-object (vector-ref x 0))))
+ (cond ((syntax-object? x)
+ (squeeze-syntax-object! x))
+ ((pair? x)
+ (set-car! x (squeeze-constant! (car x)))
+ (set-cdr! x (squeeze-constant! (cdr x)))
+ x)
+ ((vector? x)
+ (for-each (lambda (i)
+ (vector-set! x i (squeeze-constant! (vector-ref x i))))
+ (iota (vector-length x)))
+ x)
+ (else x)))
+
+(define (squeeze-tree-il! x)
+ (post-order! (lambda (x)
+ (if (const? x)
+ (set! (const-exp x)
+ (squeeze-constant! (const-exp x))))
+ #f)
+ x))
+
;; Avoid gratuitous churn in psyntax-pp.scm due to the marks and labels
;; changing session identifiers.
(set! syntax-session-id (lambda () "*"))
@@ -40,12 +99,19 @@
(close-port in))
(begin
(pretty-print (tree-il->scheme
- (canonicalize!
- (optimize!
- (macroexpand x 'c '(compile load eval))
- (current-module)
- '())))
- out)
+ (squeeze-tree-il!
+ (canonicalize!
+ (resolve-primitives!
+ (macroexpand x 'c '(compile load eval))
+ (current-module))))
+ (current-module)
+ (list #:avoid-lambda? #f
+ #:use-case? #f
+ #:strip-numeric-suffixes? #t
+ #:use-derived-syntax?
+ (and (pair? x)
+ (eq? 'let (car x)))))
+ out #:width 120 #:max-expr-width 70)
(newline out)
(loop (read in))))))
(system (format #f "mv -f ~s.tmp ~s" target target)))
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 8a0c0b8..bf45eed 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,6 +1,7 @@
;;;; -*- coding: utf-8; mode: scheme -*-
;;;;
-;;;; Copyright (C) 2001, 2004, 2006, 2009, 2010 Free Software Foundation,
Inc.
+;;;; Copyright (C) 2001, 2004, 2006, 2009, 2010,
+;;;; 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -32,7 +33,8 @@
(define genwrite:newline-str (make-string 1 #\newline))
-(define (generic-write obj display? width per-line-prefix output)
+(define (generic-write
+ obj display? width max-expr-width per-line-prefix output)
(define (read-macro? l)
(define (length1? l) (and (pair? l) (null? (cdr l))))
@@ -93,7 +95,7 @@
(if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
(let ((result '())
(left (min (+ (- (- width col) extra) 1) max-expr-width)))
- (generic-write obj display? #f ""
+ (generic-write obj display? #f max-expr-width ""
(lambda (str)
(set! result (cons str result))
(set! left (- left (string-length str)))
@@ -223,12 +225,10 @@
(define max-call-head-width 5)
- (define max-expr-width 50)
-
(define (style head)
(case head
- ((lambda let* letrec define define-public
- define-syntax let-syntax letrec-syntax)
+ ((lambda lambda* let* letrec define define* define-public
+ define-syntax let-syntax letrec-syntax with-syntax)
pp-LAMBDA)
((if set!) pp-IF)
((cond) pp-COND)
@@ -273,6 +273,7 @@
#:key
(port (or port* (current-output-port)))
(width 79)
+ (max-expr-width 50)
(display? #f)
(per-line-prefix ""))
"Pretty-print OBJ on PORT, which is a keyword argument defaulting to
@@ -286,6 +287,7 @@ Instead of with a keyword argument, you can also specify
the output
port directly after OBJ, like (pretty-print OBJ PORT)."
(generic-write obj display?
(- width (string-length per-line-prefix))
+ max-expr-width
per-line-prefix
(lambda (s) (display s port) #t)))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index d11a3f8..5635a6a 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,26890 +1,3264 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(let ((session-id-4222 (if #f #f))
- (transformer-environment-4283 (if #f #f)))
- (letrec*
- ((top-level-eval-hook-4220
- (lambda (x-24656 mod-24657)
- (primitive-eval x-24656)))
- (get-global-definition-hook-4224
- (lambda (symbol-14704 module-14705)
- (begin
- (if (if (not module-14705) (current-module) #f)
- (warn "module system is booted, we should have a module"
- symbol-14704))
- (let ((v-14706
- (module-variable
- (if module-14705
- (resolve-module (cdr module-14705))
- (current-module))
- symbol-14704)))
- (if v-14706
- (if (variable-bound? v-14706)
- (let ((val-14708 (variable-ref v-14706)))
- (if (macro? val-14708)
- (if (macro-type val-14708)
- (cons (macro-type val-14708)
- (macro-binding val-14708))
- #f)
- #f))
- #f)
- #f)))))
- (maybe-name-value!-4226
- (lambda (name-21545 val-21546)
- (if (if (struct? val-21546)
- (eq? (struct-vtable val-21546)
- (vector-ref %expanded-vtables 13))
- #f)
- (let ((meta-21553 (struct-ref val-21546 1)))
- (if (not (assq 'name meta-21553))
- (let ((v-21558
- (cons (cons 'name name-21545) meta-21553)))
- (struct-set! val-21546 1 v-21558)))))))
- (build-application-4228
- (lambda (source-14710 fun-exp-14711 arg-exps-14712)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- source-14710
- fun-exp-14711
- arg-exps-14712)))
- (analyze-variable-4233
- (lambda (mod-14718
- var-14719
- modref-cont-14720
- bare-cont-14721)
- (if (not mod-14718)
- (bare-cont-14721 var-14719)
- (let ((kind-14722 (car mod-14718))
- (mod-14723 (cdr mod-14718)))
- (if (eqv? kind-14722 'public)
- (modref-cont-14720 mod-14723 var-14719 #t)
- (if (eqv? kind-14722 'private)
- (if (not (equal? mod-14723 (module-name (current-module))))
- (modref-cont-14720 mod-14723 var-14719 #f)
- (bare-cont-14721 var-14719))
- (if (eqv? kind-14722 'bare)
- (bare-cont-14721 var-14719)
- (if (eqv? kind-14722 'hygiene)
- (if (if (not (equal?
- mod-14723
- (module-name (current-module))))
- (module-variable
- (resolve-module mod-14723)
- var-14719)
- #f)
- (modref-cont-14720 mod-14723 var-14719 #f)
- (bare-cont-14721 var-14719))
- (syntax-violation
- #f
- "bad module kind"
- var-14719
- mod-14723)))))))))
- (build-simple-lambda-4237
- (lambda (src-14750
- req-14751
- rest-14752
- vars-14753
- meta-14754
- exp-14755)
- (let ((body-14761
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- src-14750
- req-14751
- #f
- rest-14752
- #f
- '()
- vars-14753
- exp-14755
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- src-14750
- meta-14754
- body-14761))))
- (build-sequence-4242
- (lambda (src-24658 exps-24659)
- (if (null? (cdr exps-24659))
- (car exps-24659)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 12)
- src-24658
- exps-24659))))
- (build-let-4243
- (lambda (src-14773
- ids-14774
- vars-14775
- val-exps-14776
- body-exp-14777)
+(letrec*
+ ((make-void
+ (lambda (src) (make-struct (vector-ref %expanded-vtables 0) 0 src)))
+ (make-const
+ (lambda (src exp)
+ (make-struct (vector-ref %expanded-vtables 1) 0 src exp)))
+ (make-primitive-ref
+ (lambda (src name)
+ (make-struct (vector-ref %expanded-vtables 2) 0 src name)))
+ (make-lexical-ref
+ (lambda (src name gensym)
+ (make-struct (vector-ref %expanded-vtables 3) 0 src name gensym)))
+ (make-lexical-set
+ (lambda (src name gensym exp)
+ (make-struct (vector-ref %expanded-vtables 4) 0 src name gensym exp)))
+ (make-module-ref
+ (lambda (src mod name public?)
+ (make-struct (vector-ref %expanded-vtables 5) 0 src mod name public?)))
+ (make-module-set
+ (lambda (src mod name public? exp)
+ (make-struct
+ (vector-ref %expanded-vtables 6)
+ 0
+ src
+ mod
+ name
+ public?
+ exp)))
+ (make-toplevel-ref
+ (lambda (src name)
+ (make-struct (vector-ref %expanded-vtables 7) 0 src name)))
+ (make-toplevel-set
+ (lambda (src name exp)
+ (make-struct (vector-ref %expanded-vtables 8) 0 src name exp)))
+ (make-toplevel-define
+ (lambda (src name exp)
+ (make-struct (vector-ref %expanded-vtables 9) 0 src name exp)))
+ (make-conditional
+ (lambda (src test consequent alternate)
+ (make-struct
+ (vector-ref %expanded-vtables 10)
+ 0
+ src
+ test
+ consequent
+ alternate)))
+ (make-application
+ (lambda (src proc args)
+ (make-struct (vector-ref %expanded-vtables 11) 0 src proc args)))
+ (make-sequence
+ (lambda (src exps)
+ (make-struct (vector-ref %expanded-vtables 12) 0 src exps)))
+ (make-lambda
+ (lambda (src meta body)
+ (make-struct (vector-ref %expanded-vtables 13) 0 src meta body)))
+ (make-lambda-case
+ (lambda (src req opt rest kw inits gensyms body alternate)
+ (make-struct
+ (vector-ref %expanded-vtables 14)
+ 0
+ src
+ req
+ opt
+ rest
+ kw
+ inits
+ gensyms
+ body
+ alternate)))
+ (make-let
+ (lambda (src names gensyms vals body)
+ (make-struct
+ (vector-ref %expanded-vtables 15)
+ 0
+ src
+ names
+ gensyms
+ vals
+ body)))
+ (make-letrec
+ (lambda (src in-order? names gensyms vals body)
+ (make-struct
+ (vector-ref %expanded-vtables 16)
+ 0
+ src
+ in-order?
+ names
+ gensyms
+ vals
+ body)))
+ (make-dynlet
+ (lambda (src fluids vals body)
+ (make-struct
+ (vector-ref %expanded-vtables 17)
+ 0
+ src
+ fluids
+ vals
+ body)))
+ (lambda?
+ (lambda (x)
+ (and (struct? x)
+ (eq? (struct-vtable x) (vector-ref %expanded-vtables 13)))))
+ (lambda-meta (lambda (x) (struct-ref x 1)))
+ (set-lambda-meta! (lambda (x v) (struct-set! x 1 v)))
+ (top-level-eval-hook (lambda (x mod) (primitive-eval x)))
+ (local-eval-hook (lambda (x mod) (primitive-eval x)))
+ (session-id
+ (let ((v (module-variable (current-module) 'syntax-session-id)))
+ (lambda () ((variable-ref v)))))
+ (put-global-definition-hook
+ (lambda (symbol type val)
+ (module-define!
+ (current-module)
+ symbol
+ (make-syntax-transformer symbol type val))))
+ (get-global-definition-hook
+ (lambda (symbol module)
+ (if (and (not module) (current-module))
+ (warn "module system is booted, we should have a module" symbol))
+ (let ((v (module-variable
+ (if module (resolve-module (cdr module)) (current-module))
+ symbol)))
+ (and v
+ (variable-bound? v)
+ (let ((val (variable-ref v)))
+ (and (macro? val)
+ (macro-type val)
+ (cons (macro-type val) (macro-binding val))))))))
+ (decorate-source
+ (lambda (e s)
+ (if (and s (supports-source-properties? e))
+ (set-source-properties! e s))
+ e))
+ (maybe-name-value!
+ (lambda (name val)
+ (if (lambda? val)
+ (let ((meta (lambda-meta val)))
+ (if (not (assq 'name meta))
+ (set-lambda-meta! val (acons 'name name meta)))))))
+ (build-void (lambda (source) (make-void source)))
+ (build-application
+ (lambda (source fun-exp arg-exps)
+ (make-application source fun-exp arg-exps)))
+ (build-conditional
+ (lambda (source test-exp then-exp else-exp)
+ (make-conditional source test-exp then-exp else-exp)))
+ (build-dynlet
+ (lambda (source fluids vals body)
+ (make-dynlet source fluids vals body)))
+ (build-lexical-reference
+ (lambda (type source name var) (make-lexical-ref source name var)))
+ (build-lexical-assignment
+ (lambda (source name var exp)
+ (maybe-name-value! name exp)
+ (make-lexical-set source name var exp)))
+ (analyze-variable
+ (lambda (mod var modref-cont bare-cont)
+ (if (not mod)
+ (bare-cont var)
+ (let ((kind (car mod)) (mod (cdr mod)))
+ (let ((key kind))
+ (cond ((memv key '(public)) (modref-cont mod var #t))
+ ((memv key '(private))
+ (if (not (equal? mod (module-name (current-module))))
+ (modref-cont mod var #f)
+ (bare-cont var)))
+ ((memv key '(bare)) (bare-cont var))
+ ((memv key '(hygiene))
+ (if (and (not (equal? mod (module-name (current-module))))
+ (module-variable (resolve-module mod) var))
+ (modref-cont mod var #f)
+ (bare-cont var)))
+ (else (syntax-violation #f "bad module kind" var mod))))))))
+ (build-global-reference
+ (lambda (source var mod)
+ (analyze-variable
+ mod
+ var
+ (lambda (mod var public?) (make-module-ref source mod var public?))
+ (lambda (var) (make-toplevel-ref source var)))))
+ (build-global-assignment
+ (lambda (source var exp mod)
+ (maybe-name-value! var exp)
+ (analyze-variable
+ mod
+ var
+ (lambda (mod var public?)
+ (make-module-set source mod var public? exp))
+ (lambda (var) (make-toplevel-set source var exp)))))
+ (build-global-definition
+ (lambda (source var exp)
+ (maybe-name-value! var exp)
+ (make-toplevel-define source var exp)))
+ (build-simple-lambda
+ (lambda (src req rest vars meta exp)
+ (make-lambda
+ src
+ meta
+ (make-lambda-case src req #f rest #f '() vars exp #f))))
+ (build-case-lambda
+ (lambda (src meta body) (make-lambda src meta body)))
+ (build-lambda-case
+ (lambda (src req opt rest kw inits vars body else-case)
+ (make-lambda-case src req opt rest kw inits vars body else-case)))
+ (build-primref
+ (lambda (src name)
+ (if (equal? (module-name (current-module)) '(guile))
+ (make-toplevel-ref src name)
+ (make-module-ref src '(guile) name #f))))
+ (build-data (lambda (src exp) (make-const src exp)))
+ (build-sequence
+ (lambda (src exps)
+ (if (null? (cdr exps)) (car exps) (make-sequence src exps))))
+ (build-let
+ (lambda (src ids vars val-exps body-exp)
+ (for-each maybe-name-value! ids val-exps)
+ (if (null? vars) body-exp (make-let src ids vars val-exps body-exp))))
+ (build-named-let
+ (lambda (src ids vars val-exps body-exp)
+ (let ((f (car vars)) (f-name (car ids)) (vars (cdr vars)) (ids (cdr
ids)))
+ (let ((proc (build-simple-lambda src ids #f vars '() body-exp)))
+ (maybe-name-value! f-name proc)
+ (for-each maybe-name-value! ids val-exps)
+ (make-letrec
+ src
+ #f
+ (list f-name)
+ (list f)
+ (list proc)
+ (build-application
+ src
+ (build-lexical-reference 'fun src f-name f)
+ val-exps))))))
+ (build-letrec
+ (lambda (src in-order? ids vars val-exps body-exp)
+ (if (null? vars)
+ body-exp
(begin
- (for-each
- maybe-name-value!-4226
- ids-14774
- val-exps-14776)
- (if (null? vars-14775)
- body-exp-14777
- (make-struct/no-tail
- (vector-ref %expanded-vtables 15)
- src-14773
- ids-14774
- vars-14775
- val-exps-14776
- body-exp-14777)))))
- (build-named-let-4244
- (lambda (src-14801
- ids-14802
- vars-14803
- val-exps-14804
- body-exp-14805)
- (let ((f-14806 (car vars-14803))
- (f-name-14807 (car ids-14802))
- (vars-14808 (cdr vars-14803))
- (ids-14809 (cdr ids-14802)))
- (let ((proc-14810
- (let ((body-14830
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- src-14801
- ids-14809
- #f
- #f
- #f
- '()
- vars-14808
- body-exp-14805
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- src-14801
- '()
- body-14830))))
- (begin
- (if (if (struct? proc-14810)
- (eq? (struct-vtable proc-14810)
- (vector-ref %expanded-vtables 13))
- #f)
- (let ((meta-14854 (struct-ref proc-14810 1)))
- (if (not (assq 'name meta-14854))
- (let ((v-14861
- (cons (cons 'name f-name-14807) meta-14854)))
- (struct-set! proc-14810 1 v-14861)))))
- (for-each
- maybe-name-value!-4226
- ids-14809
- val-exps-14804)
- (let ((names-14885 (list f-name-14807))
- (gensyms-14886 (list f-14806))
- (vals-14887 (list proc-14810))
- (body-14888
- (let ((fun-exp-14892
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- src-14801
- f-name-14807
- f-14806)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- src-14801
- fun-exp-14892
- val-exps-14804))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 16)
- src-14801
- #f
- names-14885
- gensyms-14886
- vals-14887
- body-14888)))))))
- (build-letrec-4245
- (lambda (src-14908
- in-order?-14909
- ids-14910
- vars-14911
- val-exps-14912
- body-exp-14913)
- (if (null? vars-14911)
- body-exp-14913
- (begin
- (for-each
- maybe-name-value!-4226
- ids-14910
- val-exps-14912)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 16)
- src-14908
- in-order?-14909
- ids-14910
- vars-14911
- val-exps-14912
- body-exp-14913)))))
- (extend-env-4255
- (lambda (labels-14939 bindings-14940 r-14941)
- (if (null? labels-14939)
- r-14941
- (extend-env-4255
- (cdr labels-14939)
- (cdr bindings-14940)
- (cons (cons (car labels-14939) (car bindings-14940))
- r-14941)))))
- (extend-var-env-4256
- (lambda (labels-14942 vars-14943 r-14944)
- (if (null? labels-14942)
- r-14944
- (extend-var-env-4256
- (cdr labels-14942)
- (cdr vars-14943)
- (cons (cons (car labels-14942)
- (cons 'lexical (car vars-14943)))
- r-14944)))))
- (macros-only-env-4257
- (lambda (r-14945)
- (if (null? r-14945)
- '()
- (let ((a-14946 (car r-14945)))
- (if (eq? (car (cdr a-14946)) 'macro)
- (cons a-14946
- (macros-only-env-4257 (cdr r-14945)))
- (macros-only-env-4257 (cdr r-14945)))))))
- (global-extend-4259
- (lambda (type-14948 sym-14949 val-14950)
- (module-define!
- (current-module)
- sym-14949
- (make-syntax-transformer
- sym-14949
- type-14948
- val-14950))))
- (id?-4261
- (lambda (x-9380)
- (if (symbol? x-9380)
- #t
- (if (if (vector? x-9380)
- (if (= (vector-length x-9380) 4)
- (eq? (vector-ref x-9380 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-9380 1))
- #f))))
- (gen-labels-4264
- (lambda (ls-14960)
- (if (null? ls-14960)
- '()
- (cons (string-append
- "l-"
- (session-id-4222)
- (symbol->string (gensym "-")))
- (gen-labels-4264 (cdr ls-14960))))))
- (make-binding-wrap-4275
- (lambda (ids-14964 labels-14965 w-14966)
- (if (null? ids-14964)
- w-14966
- (cons (car w-14966)
- (cons (let ((labelvec-14967 (list->vector labels-14965)))
- (let ((n-14968 (vector-length labelvec-14967)))
- (let ((symnamevec-14969 (make-vector n-14968))
- (marksvec-14970 (make-vector n-14968)))
- (begin
- (letrec*
- ((f-14971
- (lambda (ids-14974 i-14975)
- (if (not (null? ids-14974))
- (call-with-values
- (lambda ()
- (let ((x-14978 (car ids-14974)))
- (if (if (vector? x-14978)
- (if (= (vector-length
- x-14978)
- 4)
- (eq? (vector-ref
- x-14978
- 0)
- 'syntax-object)
- #f)
- #f)
- (values
- (vector-ref x-14978 1)
- (let ((m1-14994
- (car w-14966))
- (m2-14995
- (car (vector-ref
- x-14978
- 2))))
- (if (null? m2-14995)
- m1-14994
- (append
- m1-14994
- m2-14995))))
- (values
- x-14978
- (car w-14966)))))
- (lambda (symname-15015 marks-15016)
- (begin
- (vector-set!
- symnamevec-14969
- i-14975
- symname-15015)
- (vector-set!
- marksvec-14970
- i-14975
- marks-15016)
- (f-14971
- (cdr ids-14974)
- (#{1+}# i-14975)))))))))
- (f-14971 ids-14964 0))
- (vector
- 'ribcage
- symnamevec-14969
- marksvec-14970
- labelvec-14967)))))
- (cdr w-14966))))))
- (join-wraps-4277
- (lambda (w1-15025 w2-15026)
- (let ((m1-15027 (car w1-15025))
- (s1-15028 (cdr w1-15025)))
- (if (null? m1-15027)
- (if (null? s1-15028)
- w2-15026
- (cons (car w2-15026)
- (let ((m2-15035 (cdr w2-15026)))
- (if (null? m2-15035)
- s1-15028
- (append s1-15028 m2-15035)))))
- (cons (let ((m2-15044 (car w2-15026)))
- (if (null? m2-15044)
- m1-15027
- (append m1-15027 m2-15044)))
- (let ((m2-15053 (cdr w2-15026)))
- (if (null? m2-15053)
- s1-15028
- (append s1-15028 m2-15053))))))))
- (same-marks?-4279
- (lambda (x-15058 y-15059)
- (if (eq? x-15058 y-15059)
- (eq? x-15058 y-15059)
- (if (not (null? x-15058))
- (if (not (null? y-15059))
- (if (eq? (car x-15058) (car y-15059))
- (same-marks?-4279 (cdr x-15058) (cdr y-15059))
- #f)
- #f)
- #f))))
- (id-var-name-4280
- (lambda (id-15067 w-15068)
- (letrec*
- ((search-15069
- (lambda (sym-15130 subst-15131 marks-15132)
- (if (null? subst-15131)
- (values #f marks-15132)
- (let ((fst-15133 (car subst-15131)))
- (if (eq? fst-15133 'shift)
- (search-15069
- sym-15130
- (cdr subst-15131)
- (cdr marks-15132))
- (let ((symnames-15135 (vector-ref fst-15133 1)))
- (if (vector? symnames-15135)
- (let ((n-15147 (vector-length symnames-15135)))
- (letrec*
- ((f-15148
- (lambda (i-15150)
- (if (= i-15150 n-15147)
- (search-15069
- sym-15130
- (cdr subst-15131)
- marks-15132)
- (if (if (eq? (vector-ref
- symnames-15135
- i-15150)
- sym-15130)
- (same-marks?-4279
- marks-15132
- (vector-ref
- (vector-ref fst-15133 2)
- i-15150))
- #f)
- (values
- (vector-ref
- (vector-ref fst-15133 3)
- i-15150)
- marks-15132)
- (f-15148 (#{1+}# i-15150)))))))
- (f-15148 0)))
- (letrec*
- ((f-15183
- (lambda (symnames-15185 i-15186)
- (if (null? symnames-15185)
- (search-15069
- sym-15130
- (cdr subst-15131)
- marks-15132)
- (if (if (eq? (car symnames-15185) sym-15130)
- (same-marks?-4279
- marks-15132
- (list-ref
- (vector-ref fst-15133 2)
- i-15186))
- #f)
- (values
- (list-ref
- (vector-ref fst-15133 3)
- i-15186)
- marks-15132)
- (f-15183
- (cdr symnames-15185)
- (#{1+}# i-15186)))))))
- (f-15183 symnames-15135 0))))))))))
- (if (symbol? id-15067)
- (let ((t-15072
- (search-15069
- id-15067
- (cdr w-15068)
- (car w-15068))))
- (if t-15072 t-15072 id-15067))
- (if (if (vector? id-15067)
- (if (= (vector-length id-15067) 4)
- (eq? (vector-ref id-15067 0) 'syntax-object)
- #f)
- #f)
- (let ((id-15087 (vector-ref id-15067 1))
- (w1-15088 (vector-ref id-15067 2)))
- (let ((marks-15089
- (let ((m1-15099 (car w-15068))
- (m2-15100 (car w1-15088)))
- (if (null? m2-15100)
- m1-15099
- (append m1-15099 m2-15100)))))
- (call-with-values
- (lambda ()
- (search-15069 id-15087 (cdr w-15068) marks-15089))
- (lambda (new-id-15116 marks-15117)
- (if new-id-15116
- new-id-15116
- (let ((t-15125
- (search-15069
- id-15087
- (cdr w1-15088)
- marks-15117)))
- (if t-15125 t-15125 id-15087)))))))
- (syntax-violation
- 'id-var-name
- "invalid id"
- id-15067))))))
- (locally-bound-identifiers-4281
- (lambda (w-15208 mod-15209)
- (letrec*
- ((scan-15210
- (lambda (subst-15215 results-15216)
- (if (null? subst-15215)
- results-15216
- (let ((fst-15217 (car subst-15215)))
- (if (eq? fst-15217 'shift)
- (scan-15210 (cdr subst-15215) results-15216)
- (let ((symnames-15219 (vector-ref fst-15217 1))
- (marks-15220 (vector-ref fst-15217 2)))
- (if (vector? symnames-15219)
- (scan-vector-rib-15212
- subst-15215
- symnames-15219
- marks-15220
- results-15216)
- (scan-list-rib-15211
- subst-15215
- symnames-15219
- marks-15220
- results-15216))))))))
- (scan-list-rib-15211
- (lambda (subst-15318
- symnames-15319
- marks-15320
- results-15321)
- (letrec*
- ((f-15322
- (lambda (symnames-15422 marks-15423 results-15424)
- (if (null? symnames-15422)
- (scan-15210 (cdr subst-15318) results-15424)
- (f-15322
- (cdr symnames-15422)
- (cdr marks-15423)
- (cons (wrap-4290
- (car symnames-15422)
- (let ((w-15432
- (cons (car marks-15423)
- subst-15318)))
- (cons (cons #f (car w-15432))
- (cons 'shift (cdr w-15432))))
- mod-15209)
- results-15424))))))
- (f-15322
- symnames-15319
- marks-15320
- results-15321))))
- (scan-vector-rib-15212
- (lambda (subst-15433
- symnames-15434
- marks-15435
- results-15436)
- (let ((n-15437 (vector-length symnames-15434)))
- (letrec*
- ((f-15438
- (lambda (i-15521 results-15522)
- (if (= i-15521 n-15437)
- (scan-15210 (cdr subst-15433) results-15522)
- (f-15438
- (#{1+}# i-15521)
- (cons (wrap-4290
- (vector-ref symnames-15434 i-15521)
- (let ((w-15530
- (cons (vector-ref
- marks-15435
- i-15521)
- subst-15433)))
- (cons (cons #f (car w-15530))
- (cons 'shift (cdr w-15530))))
- mod-15209)
- results-15522))))))
- (f-15438 0 results-15436))))))
- (scan-15210 (cdr w-15208) '()))))
- (valid-bound-ids?-4287
- (lambda (ids-15531)
- (if (letrec*
- ((all-ids?-15532
- (lambda (ids-15694)
- (if (null? ids-15694)
- (null? ids-15694)
- (if (let ((x-15705 (car ids-15694)))
- (if (symbol? x-15705)
- #t
- (if (if (vector? x-15705)
- (if (= (vector-length x-15705) 4)
- (eq? (vector-ref x-15705 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-15705 1))
- #f)))
- (all-ids?-15532 (cdr ids-15694))
- #f)))))
- (all-ids?-15532 ids-15531))
- (distinct-bound-ids?-4288 ids-15531)
- #f)))
- (distinct-bound-ids?-4288
- (lambda (ids-15833)
- (letrec*
- ((distinct?-15834
- (lambda (ids-15946)
- (if (null? ids-15946)
- (null? ids-15946)
- (if (not (bound-id-member?-4289
- (car ids-15946)
- (cdr ids-15946)))
- (distinct?-15834 (cdr ids-15946))
- #f)))))
- (distinct?-15834 ids-15833))))
- (bound-id-member?-4289
- (lambda (x-16156 list-16157)
- (if (not (null? list-16157))
- (let ((t-16158
- (let ((j-16239 (car list-16157)))
- (if (if (if (vector? x-16156)
- (if (= (vector-length x-16156) 4)
- (eq? (vector-ref x-16156 0) 'syntax-object)
- #f)
- #f)
- (if (vector? j-16239)
- (if (= (vector-length j-16239) 4)
- (eq? (vector-ref j-16239 0) 'syntax-object)
- #f)
- #f)
- #f)
- (if (eq? (vector-ref x-16156 1)
- (vector-ref j-16239 1))
- (same-marks?-4279
- (car (vector-ref x-16156 2))
- (car (vector-ref j-16239 2)))
- #f)
- (eq? x-16156 j-16239)))))
- (if t-16158
- t-16158
- (bound-id-member?-4289 x-16156 (cdr list-16157))))
- #f)))
- (wrap-4290
- (lambda (x-16283 w-16284 defmod-16285)
- (if (if (null? (car w-16284))
- (null? (cdr w-16284))
- #f)
- x-16283
- (if (if (vector? x-16283)
- (if (= (vector-length x-16283) 4)
- (eq? (vector-ref x-16283 0) 'syntax-object)
- #f)
- #f)
- (let ((expression-16299 (vector-ref x-16283 1))
- (wrap-16300
- (join-wraps-4277 w-16284 (vector-ref x-16283 2)))
- (module-16301 (vector-ref x-16283 3)))
- (vector
- 'syntax-object
- expression-16299
- wrap-16300
- module-16301))
- (if (null? x-16283)
- x-16283
- (vector
- 'syntax-object
- x-16283
- w-16284
- defmod-16285))))))
- (source-wrap-4291
- (lambda (x-16318 w-16319 s-16320 defmod-16321)
- (wrap-4290
- (begin
- (if (if s-16320
- (supports-source-properties? x-16318)
- #f)
- (set-source-properties! x-16318 s-16320))
- x-16318)
- w-16319
- defmod-16321)))
- (expand-sequence-4292
- (lambda (body-24664 r-24665 w-24666 s-24667 mod-24668)
- (build-sequence-4242
- s-24667
- (letrec*
- ((dobody-24791
- (lambda (body-25066 r-25067 w-25068 mod-25069)
- (if (null? body-25066)
- '()
- (let ((first-25070
- (let ((e-25120 (car body-25066)))
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-25120
- r-25067
- w-25068
- (let ((props-25130
- (source-properties
- (if (if (vector? e-25120)
- (if (= (vector-length
- e-25120)
- 4)
- (eq? (vector-ref
- e-25120
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-25120 1)
- e-25120))))
- (if (pair? props-25130) props-25130 #f))
- #f
- mod-25069
- #f))
- (lambda (type-25153
- value-25154
- form-25155
- e-25156
- w-25157
- s-25158
- mod-25159)
- (expand-expr-4298
- type-25153
- value-25154
- form-25155
- e-25156
- r-25067
- w-25157
- s-25158
- mod-25159))))))
- (cons first-25070
- (dobody-24791
- (cdr body-25066)
- r-25067
- w-25068
- mod-25069)))))))
- (dobody-24791
- body-24664
- r-24665
- w-24666
- mod-24668)))))
- (expand-top-sequence-4293
- (lambda (body-16339
- r-16340
- w-16341
- s-16342
- m-16343
- esew-16344
- mod-16345)
- (letrec*
- ((scan-16346
- (lambda (body-16477
- r-16478
- w-16479
- s-16480
- m-16481
- esew-16482
- mod-16483
- exps-16484)
- (if (null? body-16477)
- exps-16484
- (call-with-values
- (lambda ()
- (call-with-values
- (lambda ()
- (let ((e-16485 (car body-16477)))
- (syntax-type-4296
- e-16485
- r-16478
- w-16479
- (let ((t-16489
- (let ((props-16521
- (source-properties
- (if (if (vector? e-16485)
- (if (= (vector-length
- e-16485)
- 4)
- (eq? (vector-ref
- e-16485
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-16485 1)
- e-16485))))
- (if (pair? props-16521)
- props-16521
- #f))))
- (if t-16489 t-16489 s-16480))
- #f
- mod-16483
- #f)))
- (lambda (type-16544
- value-16545
- form-16546
- e-16547
- w-16548
- s-16549
- mod-16550)
- (if (eqv? type-16544 'begin-form)
- (let ((tmp-16559 ($sc-dispatch e-16547 '(_))))
- (if tmp-16559
- (@apply (lambda () exps-16484) tmp-16559)
- (let ((tmp-16563
- ($sc-dispatch
- e-16547
- '(_ any . each-any))))
- (if tmp-16563
- (@apply
- (lambda (e1-16567 e2-16568)
- (scan-16346
- (cons e1-16567 e2-16568)
- r-16478
- w-16548
- s-16549
- m-16481
- esew-16482
- mod-16550
- exps-16484))
- tmp-16563)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e-16547)))))
- (if (eqv? type-16544 'local-syntax-form)
- (expand-local-syntax-4302
- value-16545
- e-16547
- r-16478
- w-16548
- s-16549
- mod-16550
- (lambda (body-16586
- r-16587
- w-16588
- s-16589
- mod-16590)
- (scan-16346
- body-16586
- r-16587
- w-16588
- s-16589
- m-16481
- esew-16482
- mod-16590
- exps-16484)))
- (if (eqv? type-16544 'eval-when-form)
- (let ((tmp-16598
- ($sc-dispatch
- e-16547
- '(_ each-any any . each-any))))
- (if tmp-16598
- (@apply
- (lambda (x-16602 e1-16603 e2-16604)
- (let ((when-list-16605
- (parse-when-list-4295
- e-16547
- x-16602))
- (body-16606
- (cons e1-16603 e2-16604)))
- (if (eq? m-16481 'e)
- (if (memq 'eval when-list-16605)
- (scan-16346
- body-16606
- r-16478
- w-16548
- s-16549
- (if (memq 'expand
- when-list-16605)
- 'c&e
- 'e)
- '(eval)
- mod-16550
- exps-16484)
- (begin
- (if (memq 'expand
- when-list-16605)
- (let ((x-16683
-
(expand-top-sequence-4293
- body-16606
- r-16478
- w-16548
- s-16549
- 'e
- '(eval)
- mod-16550)))
- (primitive-eval x-16683)))
- exps-16484))
- (if (memq 'load when-list-16605)
- (if (let ((t-16709
- (memq 'compile
-
when-list-16605)))
- (if t-16709
- t-16709
- (let ((t-16758
- (memq 'expand
-
when-list-16605)))
- (if t-16758
- t-16758
- (if (eq? m-16481
- 'c&e)
- (memq 'eval
-
when-list-16605)
- #f)))))
- (scan-16346
- body-16606
- r-16478
- w-16548
- s-16549
- 'c&e
- '(compile load)
- mod-16550
- exps-16484)
- (if (if (eq? m-16481 'c)
- #t
- (eq? m-16481 'c&e))
- (scan-16346
- body-16606
- r-16478
- w-16548
- s-16549
- 'c
- '(load)
- mod-16550
- exps-16484)
- exps-16484))
- (if (let ((t-16887
- (memq 'compile
-
when-list-16605)))
- (if t-16887
- t-16887
- (let ((t-16936
- (memq 'expand
-
when-list-16605)))
- (if t-16936
- t-16936
- (if (eq? m-16481
- 'c&e)
- (memq 'eval
-
when-list-16605)
- #f)))))
- (begin
- (let ((x-17060
-
(expand-top-sequence-4293
- body-16606
- r-16478
- w-16548
- s-16549
- 'e
- '(eval)
- mod-16550)))
- (primitive-eval x-17060))
- exps-16484)
- exps-16484)))))
- tmp-16598)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e-16547)))
- (if (if (eqv? type-16544 'define-syntax-form)
- #t
- (eqv? type-16544
- 'define-syntax-parameter-form))
- (let ((n-17109
- (id-var-name-4280
- value-16545
- w-16548))
- (r-17110
- (macros-only-env-4257 r-16478)))
- (if (eqv? m-16481 'c)
- (if (memq 'compile esew-16482)
- (let ((e-17118
- (expand-install-global-4294
- n-17109
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-16547
- r-17110
- w-16548
- (let ((props-17391
-
(source-properties
- (if (if
(vector?
-
e-16547)
- (if (=
(vector-length
-
e-16547)
-
4)
- (eq?
(vector-ref
-
e-16547
-
0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- e-16547
- 1)
- e-16547))))
- (if (pair?
props-17391)
- props-17391
- #f))
- #f
- mod-16550
- #f))
- (lambda (type-17424
- value-17425
- form-17426
- e-17427
- w-17428
- s-17429
- mod-17430)
- (expand-expr-4298
- type-17424
- value-17425
- form-17426
- e-17427
- r-17110
- w-17428
- s-17429
- mod-17430))))))
- (begin
- (top-level-eval-hook-4220
- e-17118
- mod-16550)
- (if (memq 'load esew-16482)
- (cons e-17118 exps-16484)
- exps-16484)))
- (if (memq 'load esew-16482)
- (cons (expand-install-global-4294
- n-17109
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-16547
- r-17110
- w-16548
- (let ((props-17660
-
(source-properties
- (if (if
(vector?
-
e-16547)
- (if (=
(vector-length
-
e-16547)
-
4)
- (eq?
(vector-ref
-
e-16547
-
0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- e-16547
- 1)
- e-16547))))
- (if (pair?
props-17660)
- props-17660
- #f))
- #f
- mod-16550
- #f))
- (lambda (type-17662
- value-17663
- form-17664
- e-17665
- w-17666
- s-17667
- mod-17668)
- (expand-expr-4298
- type-17662
- value-17663
- form-17664
- e-17665
- r-17110
- w-17666
- s-17667
- mod-17668))))
- exps-16484)
- exps-16484))
- (if (eqv? m-16481 'c&e)
- (let ((e-17677
- (expand-install-global-4294
- n-17109
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-16547
- r-17110
- w-16548
- (let ((props-17949
-
(source-properties
- (if (if
(vector?
-
e-16547)
- (if (=
(vector-length
-
e-16547)
-
4)
- (eq?
(vector-ref
-
e-16547
-
0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- e-16547
- 1)
- e-16547))))
- (if (pair?
props-17949)
- props-17949
- #f))
- #f
- mod-16550
- #f))
- (lambda (type-17982
- value-17983
- form-17984
- e-17985
- w-17986
- s-17987
- mod-17988)
- (expand-expr-4298
- type-17982
- value-17983
- form-17984
- e-17985
- r-17110
- w-17986
- s-17987
- mod-17988))))))
- (begin
- (top-level-eval-hook-4220
- e-17677
- mod-16550)
- (cons e-17677 exps-16484)))
- (begin
- (if (memq 'eval esew-16482)
- (top-level-eval-hook-4220
- (let ((e-18087
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-16547
- r-17110
- w-16548
- (let ((props-18152
-
(source-properties
- (if (if
(vector?
-
e-16547)
-
(if (= (vector-length
-
e-16547)
-
4)
-
(eq? (vector-ref
-
e-16547
-
0)
-
'syntax-object)
-
#f)
- #f)
-
(vector-ref
-
e-16547
- 1)
-
e-16547))))
- (if (pair?
props-18152)
- props-18152
- #f))
- #f
- mod-16550
- #f))
- (lambda (type-18185
- value-18186
- form-18187
- e-18188
- w-18189
- s-18190
- mod-18191)
- (expand-expr-4298
- type-18185
- value-18186
- form-18187
- e-18188
- r-17110
- w-18189
- s-18190
- mod-18191)))))
- (let ((exp-18092
- (let ((fun-exp-18102
- (if (equal?
-
(module-name
-
(current-module))
- '(guile))
-
(make-struct/no-tail
- (vector-ref
-
%expanded-vtables
- 7)
- #f
-
'make-syntax-transformer)
-
(make-struct/no-tail
- (vector-ref
-
%expanded-vtables
- 5)
- #f
- '(guile)
-
'make-syntax-transformer
- #f)))
- (arg-exps-18103
- (list
(make-struct/no-tail
-
(vector-ref
-
%expanded-vtables
- 1)
- #f
-
n-17109)
-
(make-struct/no-tail
-
(vector-ref
-
%expanded-vtables
- 1)
- #f
- 'macro)
-
e-18087)))
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 11)
- #f
- fun-exp-18102
- arg-exps-18103))))
- (begin
- (if (if (struct? exp-18092)
- (eq? (struct-vtable
- exp-18092)
- (vector-ref
-
%expanded-vtables
- 13))
- #f)
- (let ((meta-18203
- (struct-ref
- exp-18092
- 1)))
- (if (not (assq 'name
-
meta-18203))
- (let ((v-18210
- (cons (cons
'name
-
n-17109)
-
meta-18203)))
- (struct-set!
- exp-18092
- 1
- v-18210)))))
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 9)
- #f
- n-17109
- exp-18092))))
- mod-16550))
- exps-16484))))
- (if (eqv? type-16544 'define-form)
- (let ((n-18293
- (id-var-name-4280
- value-16545
- w-16548)))
- (let ((type-18294
- (car (let ((t-18302
- (assq n-18293
- r-16478)))
- (if t-18302
- (cdr t-18302)
- (if (symbol? n-18293)
- (let ((t-18308
-
(get-global-definition-hook-4224
- n-18293
- mod-16550)))
- (if t-18308
- t-18308
- '(global)))
-
'(displaced-lexical)))))))
- (if (if (eqv? type-18294 'global)
- #t
- (if (eqv? type-18294 'core)
- #t
- (if (eqv? type-18294 'macro)
- #t
- (eqv? type-18294
- 'module-ref))))
- (begin
- (if (if (if (eq? m-16481 'c)
- #t
- (eq? m-16481 'c&e))
- (if (not
(module-local-variable
- (current-module)
- n-18293))
- (current-module)
- #f)
- #f)
- (let ((old-18341
- (module-variable
- (current-module)
- n-18293)))
- (if (if (variable? old-18341)
- (variable-bound?
- old-18341)
- #f)
- (module-define!
- (current-module)
- n-18293
- (variable-ref old-18341))
- (module-add!
- (current-module)
- n-18293
-
(make-undefined-variable)))))
- (cons (if (eq? m-16481 'c&e)
- (let ((x-18538
- (let ((exp-18567
-
(call-with-values
- (lambda
()
-
(syntax-type-4296
-
e-16547
-
r-16478
-
w-16548
- (let
((props-18570
-
(source-properties
-
(if (if (vector?
-
e-16547)
-
(if (= (vector-length
-
e-16547)
-
4)
-
(eq? (vector-ref
-
e-16547
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-16547
-
1)
-
e-16547))))
-
(if (pair? props-18570)
-
props-18570
-
#f))
- #f
-
mod-16550
- #f))
- (lambda
(type-18571
-
value-18572
-
form-18573
-
e-18574
-
w-18575
-
s-18576
-
mod-18577)
-
(expand-expr-4298
-
type-18571
-
value-18572
-
form-18573
-
e-18574
-
r-16478
-
w-18575
-
s-18576
-
mod-18577)))))
- (begin
- (if (if
(struct?
-
exp-18567)
- (eq?
(struct-vtable
-
exp-18567)
-
(vector-ref
-
%expanded-vtables
-
13))
- #f)
- (let
((meta-18579
-
(struct-ref
-
exp-18567
-
1)))
- (if (not
(assq 'name
-
meta-18579))
- (let
((v-18581
-
(cons (cons 'name
-
n-18293)
-
meta-18579)))
-
(struct-set!
-
exp-18567
- 1
-
v-18581)))))
-
(make-struct/no-tail
- (vector-ref
-
%expanded-vtables
- 9)
- s-16549
- n-18293
-
exp-18567)))))
- (begin
- (primitive-eval
- x-18538)
- x-18538))
- (lambda ()
- (let ((exp-18583
- (call-with-values
- (lambda ()
-
(syntax-type-4296
- e-16547
- r-16478
- w-16548
- (let
((props-18586
-
(source-properties
-
(if (if (vector?
-
e-16547)
-
(if (= (vector-length
-
e-16547)
-
4)
-
(eq? (vector-ref
-
e-16547
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-16547
-
1)
-
e-16547))))
- (if
(pair? props-18586)
-
props-18586
- #f))
- #f
- mod-16550
- #f))
- (lambda
(type-18587
-
value-18588
-
form-18589
-
e-18590
-
w-18591
-
s-18592
-
mod-18593)
-
(expand-expr-4298
- type-18587
- value-18588
- form-18589
- e-18590
- r-16478
- w-18591
- s-18592
-
mod-18593)))))
- (begin
- (if (if (struct?
- exp-18583)
- (eq?
(struct-vtable
-
exp-18583)
-
(vector-ref
-
%expanded-vtables
- 13))
- #f)
- (let ((meta-18595
- (struct-ref
- exp-18583
- 1)))
- (if (not (assq
'name
-
meta-18595))
- (let ((v-18597
- (cons
(cons 'name
-
n-18293)
-
meta-18595)))
- (struct-set!
- exp-18583
- 1
-
v-18597)))))
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 9)
- s-16549
- n-18293
- exp-18583)))))
- exps-16484))
- (if (eqv? type-18294
- 'displaced-lexical)
- (syntax-violation
- #f
- "identifier out of context"
- (wrap-4290
- (begin
- (if (if s-16549
-
(supports-source-properties?
- form-16546)
- #f)
- (set-source-properties!
- form-16546
- s-16549))
- form-16546)
- w-16548
- mod-16550)
- (wrap-4290
- value-16545
- w-16548
- mod-16550))
- (syntax-violation
- #f
- "cannot define keyword at top
level"
- (wrap-4290
- (begin
- (if (if s-16549
-
(supports-source-properties?
- form-16546)
- #f)
- (set-source-properties!
- form-16546
- s-16549))
- form-16546)
- w-16548
- mod-16550)
- (wrap-4290
- value-16545
- w-16548
- mod-16550))))))
- (cons (if (eq? m-16481 'c&e)
- (let ((x-18662
- (expand-expr-4298
- type-16544
- value-16545
- form-16546
- e-16547
- r-16478
- w-16548
- s-16549
- mod-16550)))
- (begin
- (primitive-eval x-18662)
- x-18662))
- (lambda ()
- (expand-expr-4298
- type-16544
- value-16545
- form-16546
- e-16547
- r-16478
- w-16548
- s-16549
- mod-16550)))
- exps-16484)))))))))
- (lambda (exps-18667)
- (scan-16346
- (cdr body-16477)
- r-16478
- w-16479
- s-16480
- m-16481
- esew-16482
- mod-16483
- exps-18667)))))))
- (call-with-values
- (lambda ()
- (scan-16346
- body-16339
- r-16340
- w-16341
- s-16342
- m-16343
- esew-16344
- mod-16345
- '()))
- (lambda (exps-16349)
- (if (null? exps-16349)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- s-16342)
- (build-sequence-4242
- s-16342
- (letrec*
- ((lp-16389
- (lambda (in-16473 out-16474)
- (if (null? in-16473)
- out-16474
- (let ((e-16475 (car in-16473)))
- (lp-16389
- (cdr in-16473)
- (cons (if (procedure? e-16475)
- (e-16475)
- e-16475)
- out-16474)))))))
- (lp-16389 exps-16349 '())))))))))
- (expand-install-global-4294
- (lambda (name-18668 e-18669)
- (let ((exp-18675
- (let ((fun-exp-18685
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- 'make-syntax-transformer)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- 'make-syntax-transformer
- #f)))
- (arg-exps-18686
- (list (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- name-18668)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- 'macro)
- e-18669)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-18685
- arg-exps-18686))))
- (begin
- (if (if (struct? exp-18675)
- (eq? (struct-vtable exp-18675)
- (vector-ref %expanded-vtables 13))
- #f)
- (let ((meta-18727 (struct-ref exp-18675 1)))
- (if (not (assq 'name meta-18727))
- (let ((v-18734
- (cons (cons 'name name-18668) meta-18727)))
- (struct-set! exp-18675 1 v-18734)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 9)
- #f
- name-18668
- exp-18675)))))
- (parse-when-list-4295
- (lambda (e-18745 when-list-18746)
- (let ((result-18747 (strip-4310 when-list-18746 '(()))))
- (letrec*
- ((lp-18748
- (lambda (l-18802)
- (if (null? l-18802)
- result-18747
- (if (let ((t-18804 (car l-18802)))
- (if (eq? t-18804 'compile)
- #t
- (if (eq? t-18804 'load)
- #t
- (if (eq? t-18804 'eval)
- #t
- (eq? t-18804 'expand)))))
- (lp-18748 (cdr l-18802))
- (syntax-violation
- 'eval-when
- "invalid situation"
- e-18745
- (car l-18802)))))))
- (lp-18748 result-18747)))))
- (syntax-type-4296
- (lambda (e-18806
- r-18807
- w-18808
- s-18809
- rib-18810
- mod-18811
- for-car?-18812)
- (if (symbol? e-18806)
- (let ((n-18813 (id-var-name-4280 e-18806 w-18808)))
- (let ((b-18814
- (let ((t-18823 (assq n-18813 r-18807)))
- (if t-18823
- (cdr t-18823)
- (if (symbol? n-18813)
- (let ((t-18829
- (get-global-definition-hook-4224
- n-18813
- mod-18811)))
- (if t-18829 t-18829 '(global)))
- '(displaced-lexical))))))
- (let ((type-18815 (car b-18814)))
- (if (eqv? type-18815 'lexical)
- (values
- type-18815
- (cdr b-18814)
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? type-18815 'global)
- (values
- type-18815
- n-18813
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? type-18815 'macro)
- (if for-car?-18812
- (values
- type-18815
- (cdr b-18814)
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (syntax-type-4296
- (expand-macro-4300
- (cdr b-18814)
- e-18806
- r-18807
- w-18808
- s-18809
- rib-18810
- mod-18811)
- r-18807
- '(())
- s-18809
- rib-18810
- mod-18811
- #f))
- (values
- type-18815
- (cdr b-18814)
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)))))))
- (if (pair? e-18806)
- (let ((first-18857 (car e-18806)))
- (call-with-values
- (lambda ()
- (syntax-type-4296
- first-18857
- r-18807
- w-18808
- s-18809
- rib-18810
- mod-18811
- #t))
- (lambda (ftype-18859
- fval-18860
- fform-18861
- fe-18862
- fw-18863
- fs-18864
- fmod-18865)
- (if (eqv? ftype-18859 'lexical)
- (values
- 'lexical-call
- fval-18860
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'global)
- (values
- 'global-call
- (vector
- 'syntax-object
- fval-18860
- w-18808
- fmod-18865)
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'macro)
- (syntax-type-4296
- (expand-macro-4300
- fval-18860
- e-18806
- r-18807
- w-18808
- s-18809
- rib-18810
- mod-18811)
- r-18807
- '(())
- s-18809
- rib-18810
- mod-18811
- for-car?-18812)
- (if (eqv? ftype-18859 'module-ref)
- (call-with-values
- (lambda () (fval-18860 e-18806 r-18807 w-18808))
- (lambda (e-18899
- r-18900
- w-18901
- s-18902
- mod-18903)
- (syntax-type-4296
- e-18899
- r-18900
- w-18901
- s-18902
- rib-18810
- mod-18903
- for-car?-18812)))
- (if (eqv? ftype-18859 'core)
- (values
- 'core-form
- fval-18860
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'local-syntax)
- (values
- 'local-syntax-form
- fval-18860
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'begin)
- (values
- 'begin-form
- #f
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'eval-when)
- (values
- 'eval-when-form
- #f
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (if (eqv? ftype-18859 'define)
- (let ((tmp-18935
- ($sc-dispatch
- e-18806
- '(_ any any))))
- (if (if tmp-18935
- (@apply
- (lambda (name-18939 val-18940)
- (if (symbol? name-18939)
- #t
- (if (if (vector? name-18939)
- (if (= (vector-length
- name-18939)
- 4)
- (eq? (vector-ref
- name-18939
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- name-18939
- 1))
- #f)))
- tmp-18935)
- #f)
- (@apply
- (lambda (name-18967 val-18968)
- (values
- 'define-form
- name-18967
- e-18806
- val-18968
- w-18808
- s-18809
- mod-18811))
- tmp-18935)
- (let ((tmp-18969
- ($sc-dispatch
- e-18806
- '(_ (any . any)
- any
- .
- each-any))))
- (if (if tmp-18969
- (@apply
- (lambda (name-18973
- args-18974
- e1-18975
- e2-18976)
- (if (if (symbol?
- name-18973)
- #t
- (if (if (vector?
-
name-18973)
- (if (=
(vector-length
-
name-18973)
- 4)
- (eq?
(vector-ref
-
name-18973
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- name-18973
- 1))
- #f))
- (valid-bound-ids?-4287
- (letrec*
- ((lvl-19125
- (lambda
(vars-19127
- ls-19128
- w-19129)
- (if (pair?
vars-19127)
- (lvl-19125
- (cdr
vars-19127)
- (cons
(wrap-4290
-
(car vars-19127)
-
w-19129
- #f)
-
ls-19128)
- w-19129)
- (if (if
(symbol?
-
vars-19127)
- #t
- (if
(if (vector?
-
vars-19127)
-
(if (= (vector-length
-
vars-19127)
-
4)
-
(eq? (vector-ref
-
vars-19127
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(symbol?
-
(vector-ref
-
vars-19127
-
1))
- #f))
- (cons
(wrap-4290
-
vars-19127
-
w-19129
- #f)
-
ls-19128)
- (if (null?
vars-19127)
- ls-19128
- (if (if
(vector?
-
vars-19127)
-
(if (= (vector-length
-
vars-19127)
-
4)
-
(eq? (vector-ref
-
vars-19127
-
0)
-
'syntax-object)
-
#f)
- #f)
-
(lvl-19125
-
(vector-ref
-
vars-19127
- 1)
-
ls-19128
-
(join-wraps-4277
-
w-19129
-
(vector-ref
-
vars-19127
-
2)))
- (cons
vars-19127
-
ls-19128))))))))
- (lvl-19125
- args-18974
- '()
- '(()))))
- #f))
- tmp-18969)
- #f)
- (@apply
- (lambda (name-19173
- args-19174
- e1-19175
- e2-19176)
- (values
- 'define-form
- (wrap-4290
- name-19173
- w-18808
- mod-18811)
- (wrap-4290
- e-18806
- w-18808
- mod-18811)
- (let ((e-19184
- (cons
'#(syntax-object
- lambda
- ((top)
- #(ribcage
- #(name
- args
- e1
- e2)
- #((top)
- (top)
- (top)
- (top))
-
#("l-*-1902"
-
"l-*-1903"
-
"l-*-1904"
-
"l-*-1905"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(key)
-
#((m-*-1867
-
top))
-
#("l-*-1868"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ftype
- fval
- fform
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
#("l-*-1860"
-
"l-*-1861"
-
"l-*-1862"
-
"l-*-1863"
-
"l-*-1864"
-
"l-*-1865"
-
"l-*-1866"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(first)
- #((top))
-
#("l-*-1851"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
-
for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
#("l-*-1827"
-
"l-*-1828"
-
"l-*-1829"
-
"l-*-1830"
-
"l-*-1831"
-
"l-*-1832"
-
"l-*-1833"))
- #(ribcage
-
(lambda-var-list
-
gen-var
- strip
-
expand-lambda-case
-
lambda*-formals
-
expand-simple-lambda
-
lambda-formals
-
ellipsis?
-
expand-void
-
eval-local-transformer
-
expand-local-syntax
-
expand-body
-
expand-macro
-
expand-application
-
expand-expr
- expand
-
syntax-type
-
parse-when-list
-
expand-install-global
-
expand-top-sequence
-
expand-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
-
syntax-object?
-
make-syntax-object
-
build-lexical-var
-
build-letrec
-
build-named-let
-
build-let
-
build-sequence
-
build-data
-
build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
-
build-dynlet
-
build-conditional
-
build-application
-
build-void
-
maybe-name-value!
-
decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
-
session-id
-
local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
-
lambda-meta
-
lambda?
-
make-dynlet
-
make-letrec
-
make-let
-
make-lambda-case
-
make-lambda
-
make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
-
make-module-set
-
make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
-
make-const
-
make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
("l-*-476"
-
"l-*-474"
-
"l-*-472"
-
"l-*-470"
-
"l-*-468"
-
"l-*-466"
-
"l-*-464"
-
"l-*-462"
-
"l-*-460"
-
"l-*-458"
-
"l-*-456"
-
"l-*-454"
-
"l-*-452"
-
"l-*-450"
-
"l-*-448"
-
"l-*-446"
-
"l-*-444"
-
"l-*-442"
-
"l-*-440"
-
"l-*-438"
-
"l-*-436"
-
"l-*-434"
-
"l-*-432"
-
"l-*-430"
-
"l-*-428"
-
"l-*-426"
-
"l-*-424"
-
"l-*-422"
-
"l-*-420"
-
"l-*-418"
-
"l-*-416"
-
"l-*-414"
-
"l-*-412"
-
"l-*-410"
-
"l-*-408"
-
"l-*-406"
-
"l-*-404"
-
"l-*-402"
-
"l-*-400"
-
"l-*-399"
-
"l-*-397"
-
"l-*-394"
-
"l-*-393"
-
"l-*-392"
-
"l-*-390"
-
"l-*-389"
-
"l-*-387"
-
"l-*-385"
-
"l-*-383"
-
"l-*-381"
-
"l-*-379"
-
"l-*-377"
-
"l-*-375"
-
"l-*-373"
-
"l-*-370"
-
"l-*-368"
-
"l-*-367"
-
"l-*-365"
-
"l-*-363"
-
"l-*-361"
-
"l-*-359"
-
"l-*-358"
-
"l-*-357"
-
"l-*-356"
-
"l-*-354"
-
"l-*-353"
-
"l-*-350"
-
"l-*-348"
-
"l-*-346"
-
"l-*-344"
-
"l-*-342"
-
"l-*-340"
-
"l-*-338"
-
"l-*-337"
-
"l-*-336"
-
"l-*-334"
-
"l-*-332"
-
"l-*-331"
-
"l-*-328"
-
"l-*-327"
-
"l-*-325"
-
"l-*-323"
-
"l-*-321"
-
"l-*-319"
-
"l-*-317"
-
"l-*-315"
-
"l-*-313"
-
"l-*-311"
-
"l-*-309"
-
"l-*-306"
-
"l-*-304"
-
"l-*-302"
-
"l-*-300"
-
"l-*-298"
-
"l-*-296"
-
"l-*-294"
-
"l-*-292"
-
"l-*-290"
-
"l-*-288"
-
"l-*-286"
-
"l-*-284"
-
"l-*-282"
-
"l-*-280"
-
"l-*-278"
-
"l-*-276"
-
"l-*-274"
-
"l-*-272"
-
"l-*-270"
-
"l-*-268"
-
"l-*-266"
-
"l-*-264"
-
"l-*-262"
-
"l-*-260"
-
"l-*-258"
-
"l-*-256"
-
"l-*-255"
-
"l-*-254"
-
"l-*-253"
-
"l-*-252"
-
"l-*-250"
-
"l-*-248"
-
"l-*-246"
-
"l-*-243"
-
"l-*-241"
-
"l-*-239"
-
"l-*-237"
-
"l-*-235"
-
"l-*-233"
-
"l-*-231"
-
"l-*-229"
-
"l-*-227"
-
"l-*-225"
-
"l-*-223"
-
"l-*-221"
-
"l-*-219"
-
"l-*-217"
-
"l-*-215"
-
"l-*-213"
-
"l-*-211"
-
"l-*-209"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
-
("l-*-47"
-
"l-*-46"
-
"l-*-45")))
- (hygiene
- guile))
- (wrap-4290
- (cons
args-19174
- (cons
e1-19175
-
e2-19176))
- w-18808
-
mod-18811))))
- (begin
- (if (if s-18809
-
(supports-source-properties?
- e-19184)
- #f)
-
(set-source-properties!
- e-19184
- s-18809))
- e-19184))
- '(())
- s-18809
- mod-18811))
- tmp-18969)
- (let ((tmp-19191
- ($sc-dispatch
- e-18806
- '(_ any))))
- (if (if tmp-19191
- (@apply
- (lambda (name-19195)
- (if (symbol?
- name-19195)
- #t
- (if (if (vector?
-
name-19195)
- (if (=
(vector-length
-
name-19195)
- 4)
- (eq?
(vector-ref
-
name-19195
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- name-19195
- 1))
- #f)))
- tmp-19191)
- #f)
- (@apply
- (lambda (name-19222)
- (values
- 'define-form
- (wrap-4290
- name-19222
- w-18808
- mod-18811)
- (wrap-4290
- e-18806
- w-18808
- mod-18811)
- '(#(syntax-object
- if
- ((top)
- #(ribcage
- #(name)
- #((top))
- #("l-*-1915"))
- #(ribcage () () ())
- #(ribcage
- #(key)
- #((m-*-1867 top))
- #("l-*-1868"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(ftype
- fval
- fform
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1860"
- "l-*-1861"
- "l-*-1862"
- "l-*-1863"
- "l-*-1864"
- "l-*-1865"
- "l-*-1866"))
- #(ribcage () () ())
- #(ribcage
- #(first)
- #((top))
- #("l-*-1851"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
- for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1827"
- "l-*-1828"
- "l-*-1829"
- "l-*-1830"
- "l-*-1831"
- "l-*-1832"
- "l-*-1833"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
-
expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
-
make-binding-wrap
- extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
-
ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
- syntax-object?
-
make-syntax-object
-
build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
-
make-lambda-case
- make-lambda
- make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
- make-module-set
- make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- #(syntax-object
- #f
- ((top)
- #(ribcage
- #(name)
- #((top))
- #("l-*-1915"))
- #(ribcage () () ())
- #(ribcage
- #(key)
- #((m-*-1867 top))
- #("l-*-1868"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(ftype
- fval
- fform
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1860"
- "l-*-1861"
- "l-*-1862"
- "l-*-1863"
- "l-*-1864"
- "l-*-1865"
- "l-*-1866"))
- #(ribcage () () ())
- #(ribcage
- #(first)
- #((top))
- #("l-*-1851"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
- for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1827"
- "l-*-1828"
- "l-*-1829"
- "l-*-1830"
- "l-*-1831"
- "l-*-1832"
- "l-*-1833"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
-
expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
-
make-binding-wrap
- extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
-
ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
- syntax-object?
-
make-syntax-object
-
build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
-
make-lambda-case
- make-lambda
- make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
- make-module-set
- make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- #(syntax-object
- #f
- ((top)
- #(ribcage
- #(name)
- #((top))
- #("l-*-1915"))
- #(ribcage () () ())
- #(ribcage
- #(key)
- #((m-*-1867 top))
- #("l-*-1868"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(ftype
- fval
- fform
- fe
- fw
- fs
- fmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1860"
- "l-*-1861"
- "l-*-1862"
- "l-*-1863"
- "l-*-1864"
- "l-*-1865"
- "l-*-1866"))
- #(ribcage () () ())
- #(ribcage
- #(first)
- #((top))
- #("l-*-1851"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(e
- r
- w
- s
- rib
- mod
- for-car?)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-1827"
- "l-*-1828"
- "l-*-1829"
- "l-*-1830"
- "l-*-1831"
- "l-*-1832"
- "l-*-1833"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
-
expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
-
make-binding-wrap
- extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
-
ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
- syntax-object?
-
make-syntax-object
-
build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
-
make-lambda-case
- make-lambda
- make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
- make-module-set
- make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile)))
- '(())
- s-18809
- mod-18811))
- tmp-19191)
- (syntax-violation
- #f
- "source expression failed
to match any pattern"
- e-18806)))))))
- (if (eqv? ftype-18859 'define-syntax)
- (let ((tmp-19246
- ($sc-dispatch
- e-18806
- '(_ any any))))
- (if (if tmp-19246
- (@apply
- (lambda (name-19250 val-19251)
- (if (symbol? name-19250)
- #t
- (if (if (vector?
- name-19250)
- (if (=
(vector-length
- name-19250)
- 4)
- (eq? (vector-ref
- name-19250
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- name-19250
- 1))
- #f)))
- tmp-19246)
- #f)
- (@apply
- (lambda (name-19278 val-19279)
- (values
- 'define-syntax-form
- name-19278
- e-18806
- val-19279
- w-18808
- s-18809
- mod-18811))
- tmp-19246)
- (syntax-violation
- #f
- "source expression failed to
match any pattern"
- e-18806)))
- (if (eqv? ftype-18859
- 'define-syntax-parameter)
- (let ((tmp-19293
- ($sc-dispatch
- e-18806
- '(_ any any))))
- (if (if tmp-19293
- (@apply
- (lambda (name-19297
- val-19298)
- (if (symbol? name-19297)
- #t
- (if (if (vector?
- name-19297)
- (if (=
(vector-length
-
name-19297)
- 4)
- (eq? (vector-ref
-
name-19297
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- name-19297
- 1))
- #f)))
- tmp-19293)
- #f)
- (@apply
- (lambda (name-19325 val-19326)
- (values
-
'define-syntax-parameter-form
- name-19325
- e-18806
- val-19326
- w-18808
- s-18809
- mod-18811))
- tmp-19293)
+ (for-each maybe-name-value! ids val-exps)
+ (make-letrec src in-order? ids vars val-exps body-exp)))))
+ (make-syntax-object
+ (lambda (expression wrap module)
+ (vector 'syntax-object expression wrap module)))
+ (syntax-object?
+ (lambda (x)
+ (and (vector? x)
+ (= (vector-length x) 4)
+ (eq? (vector-ref x 0) 'syntax-object))))
+ (syntax-object-expression (lambda (x) (vector-ref x 1)))
+ (syntax-object-wrap (lambda (x) (vector-ref x 2)))
+ (syntax-object-module (lambda (x) (vector-ref x 3)))
+ (set-syntax-object-expression!
+ (lambda (x update) (vector-set! x 1 update)))
+ (set-syntax-object-wrap!
+ (lambda (x update) (vector-set! x 2 update)))
+ (set-syntax-object-module!
+ (lambda (x update) (vector-set! x 3 update)))
+ (source-annotation
+ (lambda (x)
+ (let ((props (source-properties
+ (if (syntax-object? x) (syntax-object-expression x) x))))
+ (and (pair? props) props))))
+ (extend-env
+ (lambda (labels bindings r)
+ (if (null? labels)
+ r
+ (extend-env
+ (cdr labels)
+ (cdr bindings)
+ (cons (cons (car labels) (car bindings)) r)))))
+ (extend-var-env
+ (lambda (labels vars r)
+ (if (null? labels)
+ r
+ (extend-var-env
+ (cdr labels)
+ (cdr vars)
+ (cons (cons (car labels) (cons 'lexical (car vars))) r)))))
+ (macros-only-env
+ (lambda (r)
+ (if (null? r)
+ '()
+ (let ((a (car r)))
+ (if (eq? (cadr a) 'macro)
+ (cons a (macros-only-env (cdr r)))
+ (macros-only-env (cdr r)))))))
+ (lookup
+ (lambda (x r mod)
+ (let ((t (assq x r)))
+ (cond (t (cdr t))
+ ((symbol? x) (or (get-global-definition-hook x mod) '(global)))
+ (else '(displaced-lexical))))))
+ (global-extend
+ (lambda (type sym val) (put-global-definition-hook sym type val)))
+ (nonsymbol-id?
+ (lambda (x)
+ (and (syntax-object? x) (symbol? (syntax-object-expression x)))))
+ (id? (lambda (x)
+ (if (symbol? x)
+ #t
+ (and (syntax-object? x) (symbol? (syntax-object-expression x))))))
+ (id-sym-name&marks
+ (lambda (x w)
+ (if (syntax-object? x)
+ (values
+ (syntax-object-expression x)
+ (join-marks (car w) (car (syntax-object-wrap x))))
+ (values x (car w)))))
+ (gen-label
+ (lambda ()
+ (string-append "l-" (session-id) (symbol->string (gensym "-")))))
+ (gen-labels
+ (lambda (ls)
+ (if (null? ls) '() (cons (gen-label) (gen-labels (cdr ls))))))
+ (make-ribcage
+ (lambda (symnames marks labels)
+ (vector 'ribcage symnames marks labels)))
+ (ribcage?
+ (lambda (x)
+ (and (vector? x)
+ (= (vector-length x) 4)
+ (eq? (vector-ref x 0) 'ribcage))))
+ (ribcage-symnames (lambda (x) (vector-ref x 1)))
+ (ribcage-marks (lambda (x) (vector-ref x 2)))
+ (ribcage-labels (lambda (x) (vector-ref x 3)))
+ (set-ribcage-symnames! (lambda (x update) (vector-set! x 1 update)))
+ (set-ribcage-marks! (lambda (x update) (vector-set! x 2 update)))
+ (set-ribcage-labels! (lambda (x update) (vector-set! x 3 update)))
+ (anti-mark
+ (lambda (w) (cons (cons #f (car w)) (cons 'shift (cdr w)))))
+ (extend-ribcage!
+ (lambda (ribcage id label)
+ (set-ribcage-symnames!
+ ribcage
+ (cons (syntax-object-expression id) (ribcage-symnames ribcage)))
+ (set-ribcage-marks!
+ ribcage
+ (cons (car (syntax-object-wrap id)) (ribcage-marks ribcage)))
+ (set-ribcage-labels! ribcage (cons label (ribcage-labels ribcage)))))
+ (make-binding-wrap
+ (lambda (ids labels w)
+ (if (null? ids)
+ w
+ (cons (car w)
+ (cons (let* ((labelvec (list->vector labels)) (n (vector-length
labelvec)))
+ (let ((symnamevec (make-vector n)) (marksvec
(make-vector n)))
+ (let f ((ids ids) (i 0))
+ (if (not (null? ids))
+ (call-with-values
+ (lambda () (id-sym-name&marks (car ids) w))
+ (lambda (symname marks)
+ (vector-set! symnamevec i symname)
+ (vector-set! marksvec i marks)
+ (f (cdr ids) (+ i 1))))))
+ (make-ribcage symnamevec marksvec labelvec)))
+ (cdr w))))))
+ (smart-append (lambda (m1 m2) (if (null? m2) m1 (append m1 m2))))
+ (join-wraps
+ (lambda (w1 w2)
+ (let ((m1 (car w1)) (s1 (cdr w1)))
+ (if (null? m1)
+ (if (null? s1) w2 (cons (car w2) (smart-append s1 (cdr w2))))
+ (cons (smart-append m1 (car w2)) (smart-append s1 (cdr w2)))))))
+ (join-marks (lambda (m1 m2) (smart-append m1 m2)))
+ (same-marks?
+ (lambda (x y)
+ (or (eq? x y)
+ (and (not (null? x))
+ (not (null? y))
+ (eq? (car x) (car y))
+ (same-marks? (cdr x) (cdr y))))))
+ (id-var-name
+ (lambda (id w)
+ (letrec*
+ ((search
+ (lambda (sym subst marks)
+ (if (null? subst)
+ (values #f marks)
+ (let ((fst (car subst)))
+ (if (eq? fst 'shift)
+ (search sym (cdr subst) (cdr marks))
+ (let ((symnames (ribcage-symnames fst)))
+ (if (vector? symnames)
+ (search-vector-rib sym subst marks symnames fst)
+ (search-list-rib sym subst marks symnames fst))))))))
+ (search-list-rib
+ (lambda (sym subst marks symnames ribcage)
+ (let f ((symnames symnames) (i 0))
+ (cond ((null? symnames) (search sym (cdr subst) marks))
+ ((and (eq? (car symnames) sym)
+ (same-marks? marks (list-ref (ribcage-marks
ribcage) i)))
+ (values (list-ref (ribcage-labels ribcage) i) marks))
+ (else (f (cdr symnames) (+ i 1)))))))
+ (search-vector-rib
+ (lambda (sym subst marks symnames ribcage)
+ (let ((n (vector-length symnames)))
+ (let f ((i 0))
+ (cond ((= i n) (search sym (cdr subst) marks))
+ ((and (eq? (vector-ref symnames i) sym)
+ (same-marks? marks (vector-ref (ribcage-marks
ribcage) i)))
+ (values (vector-ref (ribcage-labels ribcage) i)
marks))
+ (else (f (+ i 1)))))))))
+ (cond ((symbol? id) (or (search id (cdr w) (car w)) id))
+ ((syntax-object? id)
+ (let ((id (syntax-object-expression id)) (w1
(syntax-object-wrap id)))
+ (let ((marks (join-marks (car w) (car w1))))
+ (call-with-values
+ (lambda () (search id (cdr w) marks))
+ (lambda (new-id marks) (or new-id (search id (cdr w1)
marks) id))))))
+ (else (syntax-violation 'id-var-name "invalid id" id))))))
+ (locally-bound-identifiers
+ (lambda (w mod)
+ (letrec*
+ ((scan (lambda (subst results)
+ (if (null? subst)
+ results
+ (let ((fst (car subst)))
+ (if (eq? fst 'shift)
+ (scan (cdr subst) results)
+ (let ((symnames (ribcage-symnames fst)) (marks
(ribcage-marks fst)))
+ (if (vector? symnames)
+ (scan-vector-rib subst symnames marks results)
+ (scan-list-rib subst symnames marks results))))))))
+ (scan-list-rib
+ (lambda (subst symnames marks results)
+ (let f ((symnames symnames) (marks marks) (results results))
+ (if (null? symnames)
+ (scan (cdr subst) results)
+ (f (cdr symnames)
+ (cdr marks)
+ (cons (wrap (car symnames) (anti-mark (cons (car marks)
subst)) mod)
+ results))))))
+ (scan-vector-rib
+ (lambda (subst symnames marks results)
+ (let ((n (vector-length symnames)))
+ (let f ((i 0) (results results))
+ (if (= i n)
+ (scan (cdr subst) results)
+ (f (+ i 1)
+ (cons (wrap (vector-ref symnames i)
+ (anti-mark (cons (vector-ref marks i)
subst))
+ mod)
+ results))))))))
+ (scan (cdr w) '()))))
+ (resolve-identifier
+ (lambda (id w r mod)
+ (letrec*
+ ((resolve-global
+ (lambda (var mod)
+ (let ((b (or (get-global-definition-hook var mod) '(global))))
+ (if (eq? (car b) 'global)
+ (values 'global var mod)
+ (values (car b) (cdr b) mod)))))
+ (resolve-lexical
+ (lambda (label mod)
+ (let ((b (or (assq-ref r label) '(displaced-lexical))))
+ (values (car b) (cdr b) mod)))))
+ (let ((n (id-var-name id w)))
+ (cond ((symbol? n)
+ (resolve-global
+ n
+ (if (syntax-object? id) (syntax-object-module id) mod)))
+ ((string? n)
+ (resolve-lexical
+ n
+ (if (syntax-object? id) (syntax-object-module id) mod)))
+ (else (error "unexpected id-var-name" id w n)))))))
+ (transformer-environment
+ (make-fluid
+ (lambda (k)
+ (error "called outside the dynamic extent of a syntax transformer"))))
+ (with-transformer-environment
+ (lambda (k) ((fluid-ref transformer-environment) k)))
+ (free-id=?
+ (lambda (i j)
+ (and (eq? (let ((x i)) (if (syntax-object? x) (syntax-object-expression
x) x))
+ (let ((x j)) (if (syntax-object? x) (syntax-object-expression
x) x)))
+ (eq? (id-var-name i '(())) (id-var-name j '(()))))))
+ (bound-id=?
+ (lambda (i j)
+ (if (and (syntax-object? i) (syntax-object? j))
+ (and (eq? (syntax-object-expression i) (syntax-object-expression j))
+ (same-marks?
+ (car (syntax-object-wrap i))
+ (car (syntax-object-wrap j))))
+ (eq? i j))))
+ (valid-bound-ids?
+ (lambda (ids)
+ (and (let all-ids? ((ids ids))
+ (or (null? ids) (and (id? (car ids)) (all-ids? (cdr ids)))))
+ (distinct-bound-ids? ids))))
+ (distinct-bound-ids?
+ (lambda (ids)
+ (let distinct? ((ids ids))
+ (or (null? ids)
+ (and (not (bound-id-member? (car ids) (cdr ids)))
+ (distinct? (cdr ids)))))))
+ (bound-id-member?
+ (lambda (x list)
+ (and (not (null? list))
+ (or (bound-id=? x (car list)) (bound-id-member? x (cdr list))))))
+ (wrap (lambda (x w defmod)
+ (cond ((and (null? (car w)) (null? (cdr w))) x)
+ ((syntax-object? x)
+ (make-syntax-object
+ (syntax-object-expression x)
+ (join-wraps w (syntax-object-wrap x))
+ (syntax-object-module x)))
+ ((null? x) x)
+ (else (make-syntax-object x w defmod)))))
+ (source-wrap
+ (lambda (x w s defmod) (wrap (decorate-source x s) w defmod)))
+ (expand-sequence
+ (lambda (body r w s mod)
+ (build-sequence
+ s
+ (let dobody ((body body) (r r) (w w) (mod mod))
+ (if (null? body)
+ '()
+ (let ((first (expand (car body) r w mod)))
+ (cons first (dobody (cdr body) r w mod))))))))
+ (expand-top-sequence
+ (lambda (body r w s m esew mod)
+ (letrec*
+ ((scan (lambda (body r w s m esew mod exps)
+ (if (null? body)
+ exps
+ (call-with-values
+ (lambda ()
+ (call-with-values
+ (lambda ()
+ (let ((e (car body)))
+ (syntax-type e r w (or (source-annotation e) s)
#f mod #f)))
+ (lambda (type value form e w s mod)
+ (let ((key type))
+ (cond ((memv key '(begin-form))
+ (let* ((tmp e) (tmp-1 ($sc-dispatch tmp
'(_))))
+ (if tmp-1
+ (apply (lambda () exps) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_
any . each-any))))
+ (if tmp-1
+ (apply (lambda (e1 e2) (scan
(cons e1 e2) r w s m esew mod exps))
+ tmp-1)
(syntax-violation
#f
"source expression failed to
match any pattern"
- e-18806)))
- (values
- 'call
+ tmp))))))
+ ((memv key '(local-syntax-form))
+ (expand-local-syntax
+ value
+ e
+ r
+ w
+ s
+ mod
+ (lambda (body r w s mod) (scan body r w
s m esew mod exps))))
+ ((memv key '(eval-when-form))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1
'(_ each-any any . each-any))))
+ (if tmp
+ (apply (lambda (x e1 e2)
+ (let ((when-list
(parse-when-list e x)) (body (cons e1 e2)))
+ (cond ((eq? m 'e)
+ (if (memq 'eval
when-list)
+ (scan body
+ r
+ w
+ s
+ (if (memq
'expand when-list) 'c&e 'e)
+ '(eval)
+ mod
+ exps)
+ (begin
+ (if (memq
'expand when-list)
+
(top-level-eval-hook
+
(expand-top-sequence body r w s 'e '(eval) mod)
+ mod))
+ (values exps))))
+ ((memq 'load
when-list)
+ (cond ((or (memq
'compile when-list)
+ (memq
'expand when-list)
+ (and
(eq? m 'c&e) (memq 'eval when-list)))
+ (scan body r
w s 'c&e '(compile load) mod exps))
+ ((memq m '(c
c&e))
+ (scan body r
w s 'c '(load) mod exps))
+ (else (values
exps))))
+ ((or (memq 'compile
when-list)
+ (memq 'expand
when-list)
+ (and (eq? m
'c&e) (memq 'eval when-list)))
+ (top-level-eval-hook
+
(expand-top-sequence body r w s 'e '(eval) mod)
+ mod)
+ (values exps))
+ (else (values
exps)))))
+ tmp)
+ (syntax-violation
#f
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)))))))))))))))
- (if (if (vector? e-18806)
- (if (= (vector-length e-18806) 4)
- (eq? (vector-ref e-18806 0) 'syntax-object)
- #f)
- #f)
- (syntax-type-4296
- (vector-ref e-18806 1)
- r-18807
- (join-wraps-4277 w-18808 (vector-ref e-18806 2))
- (let ((t-19353
- (let ((props-19385
- (source-properties
- (if (if (vector? e-18806)
- (if (= (vector-length e-18806) 4)
- (eq? (vector-ref e-18806 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-18806 1)
- e-18806))))
- (if (pair? props-19385) props-19385 #f))))
- (if t-19353 t-19353 s-18809))
- rib-18810
- (let ((t-19408 (vector-ref e-18806 3)))
- (if t-19408 t-19408 mod-18811))
- for-car?-18812)
- (if (self-evaluating? e-18806)
- (values
- 'constant
- #f
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)
- (values
- 'other
- #f
- e-18806
- e-18806
- w-18808
- s-18809
- mod-18811)))))))
- (expand-4297
- (lambda (e-19417 r-19418 w-19419 mod-19420)
+ "source expression failed to match
any pattern"
+ tmp-1))))
+ ((memv key '(define-syntax-form
define-syntax-parameter-form))
+ (let ((n (id-var-name value w)) (r
(macros-only-env r)))
+ (let ((key m))
+ (cond ((memv key '(c))
+ (cond ((memq 'compile esew)
+ (let ((e
(expand-install-global n (expand e r w mod))))
+ (top-level-eval-hook
e mod)
+ (if (memq 'load esew)
(values (cons e exps)) (values exps))))
+ ((memq 'load esew)
+ (values
+ (cons
(expand-install-global n (expand e r w mod)) exps)))
+ (else (values exps))))
+ ((memv key '(c&e))
+ (let ((e
(expand-install-global n (expand e r w mod))))
+ (top-level-eval-hook e mod)
+ (values (cons e exps))))
+ (else
+ (if (memq 'eval esew)
+ (top-level-eval-hook
+ (expand-install-global n
(expand e r w mod))
+ mod))
+ (values exps))))))
+ ((memv key '(define-form))
+ (let* ((n (id-var-name value w)) (type
(car (lookup n r mod))) (key type))
+ (cond ((memv key '(global core macro
module-ref))
+ (if (and (memq m '(c c&e))
+ (not
(module-local-variable (current-module) n))
+ (current-module))
+ (let ((old (module-variable
(current-module) n)))
+ (if (and (variable? old)
(variable-bound? old))
+ (module-define!
(current-module) n (variable-ref old))
+ (module-add!
(current-module) n (make-undefined-variable)))))
+ (values
+ (cons (if (eq? m 'c&e)
+ (let ((x
(build-global-definition s n (expand e r w mod))))
+ (top-level-eval-hook
x mod)
+ x)
+ (lambda ()
(build-global-definition s n (expand e r w mod))))
+ exps)))
+ ((memv key '(displaced-lexical))
+ (syntax-violation
+ #f
+ "identifier out of context"
+ (source-wrap form w s mod)
+ (wrap value w mod)))
+ (else
+ (syntax-violation
+ #f
+ "cannot define keyword at top
level"
+ (source-wrap form w s mod)
+ (wrap value w mod))))))
+ (else
+ (values
+ (cons (if (eq? m 'c&e)
+ (let ((x (expand-expr type
value form e r w s mod)))
+ (top-level-eval-hook x mod)
+ x)
+ (lambda () (expand-expr type
value form e r w s mod)))
+ exps))))))))
+ (lambda (exps) (scan (cdr body) r w s m esew mod
exps)))))))
(call-with-values
- (lambda ()
- (syntax-type-4296
- e-19417
- r-19418
- w-19419
- (let ((props-19427
- (source-properties
- (if (if (vector? e-19417)
- (if (= (vector-length e-19417) 4)
- (eq? (vector-ref e-19417 0) 'syntax-object)
- #f)
- #f)
- (vector-ref e-19417 1)
- e-19417))))
- (if (pair? props-19427) props-19427 #f))
- #f
- mod-19420
- #f))
- (lambda (type-19450
- value-19451
- form-19452
- e-19453
- w-19454
- s-19455
- mod-19456)
- (expand-expr-4298
- type-19450
- value-19451
- form-19452
- e-19453
- r-19418
- w-19454
- s-19455
- mod-19456)))))
- (expand-expr-4298
- (lambda (type-19459
- value-19460
- form-19461
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466)
- (if (eqv? type-19459 'lexical)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- s-19465
- e-19462
- value-19460)
- (if (if (eqv? type-19459 'core)
- #t
- (eqv? type-19459 'core-form))
- (value-19460
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466)
- (if (eqv? type-19459 'module-ref)
- (call-with-values
- (lambda () (value-19460 e-19462 r-19463 w-19464))
- (lambda (e-19502 r-19503 w-19504 s-19505 mod-19506)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-19502
- r-19503
- w-19504
- (let ((props-19522
- (source-properties
- (if (if (vector? e-19502)
- (if (= (vector-length e-19502) 4)
- (eq? (vector-ref e-19502 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-19502 1)
- e-19502))))
- (if (pair? props-19522) props-19522 #f))
- #f
- mod-19506
- #f))
- (lambda (type-19555
- value-19556
- form-19557
- e-19558
- w-19559
- s-19560
- mod-19561)
- (expand-expr-4298
- type-19555
- value-19556
- form-19557
- e-19558
- r-19503
- w-19559
- s-19560
- mod-19561)))))
- (if (eqv? type-19459 'lexical-call)
- (expand-application-4299
- (let ((id-19572 (car e-19462)))
- (let ((source-19577
- (let ((props-19587
- (source-properties
- (if (if (vector? id-19572)
- (if (= (vector-length id-19572) 4)
- (eq? (vector-ref id-19572 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-19572 1)
- id-19572))))
- (if (pair? props-19587) props-19587 #f)))
- (name-19578
- (if (if (vector? id-19572)
- (if (= (vector-length id-19572) 4)
- (eq? (vector-ref id-19572 0)
- 'syntax-object)
- #f)
- #f)
- (syntax->datum id-19572)
- id-19572)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- source-19577
- name-19578
- value-19460)))
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466)
- (if (eqv? type-19459 'global-call)
- (expand-application-4299
- (let ((source-19630
- (let ((x-19669 (car e-19462)))
- (let ((props-19670
- (source-properties
- (if (if (vector? x-19669)
- (if (= (vector-length x-19669)
- 4)
- (eq? (vector-ref x-19669 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-19669 1)
- x-19669))))
- (if (pair? props-19670) props-19670 #f))))
- (var-19631
- (if (if (vector? value-19460)
- (if (= (vector-length value-19460) 4)
- (eq? (vector-ref value-19460 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref value-19460 1)
- value-19460))
- (mod-19632
- (if (if (vector? value-19460)
- (if (= (vector-length value-19460) 4)
- (eq? (vector-ref value-19460 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref value-19460 3)
- mod-19466)))
- (analyze-variable-4233
- mod-19632
- var-19631
- (lambda (mod-19658 var-19659 public?-19660)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- source-19630
- mod-19658
- var-19659
- public?-19660))
- (lambda (var-19683)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- source-19630
- var-19683))))
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466)
- (if (eqv? type-19459 'constant)
- (let ((exp-19698
- (strip-4310
- (wrap-4290
- (begin
- (if (if s-19465
- (supports-source-properties? e-19462)
- #f)
- (set-source-properties! e-19462 s-19465))
- e-19462)
- w-19464
- mod-19466)
- '(()))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- s-19465
- exp-19698))
- (if (eqv? type-19459 'global)
- (analyze-variable-4233
- mod-19466
- value-19460
- (lambda (mod-19737 var-19738 public?-19739)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- s-19465
- mod-19737
- var-19738
- public?-19739))
- (lambda (var-19748)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- s-19465
- var-19748)))
- (if (eqv? type-19459 'call)
- (expand-application-4299
- (let ((e-19766 (car e-19462)))
+ (lambda () (scan body r w s m esew mod '()))
+ (lambda (exps)
+ (if (null? exps)
+ (build-void s)
+ (build-sequence
+ s
+ (let lp ((in exps) (out '()))
+ (if (null? in)
+ out
+ (let ((e (car in)))
+ (lp (cdr in) (cons (if (procedure? e) (e) e)
out))))))))))))
+ (expand-install-global
+ (lambda (name e)
+ (build-global-definition
+ #f
+ name
+ (build-application
+ #f
+ (build-primref #f 'make-syntax-transformer)
+ (list (build-data #f name) (build-data #f 'macro) e)))))
+ (parse-when-list
+ (lambda (e when-list)
+ (let ((result (strip when-list '(()))))
+ (let lp ((l result))
+ (cond ((null? l) result)
+ ((memq (car l) '(compile load eval expand)) (lp (cdr l)))
+ (else (syntax-violation 'eval-when "invalid situation" e (car
l))))))))
+ (syntax-type
+ (lambda (e r w s rib mod for-car?)
+ (cond ((symbol? e)
+ (let* ((n (id-var-name e w))
+ (b (lookup n r mod))
+ (type (car b))
+ (key type))
+ (cond ((memv key '(lexical)) (values type (cdr b) e e w s mod))
+ ((memv key '(global)) (values type n e e w s mod))
+ ((memv key '(macro))
+ (if for-car?
+ (values type (cdr b) e e w s mod)
+ (syntax-type
+ (expand-macro (cdr b) e r w s rib mod)
+ r
+ '(())
+ s
+ rib
+ mod
+ #f)))
+ (else (values type (cdr b) e e w s mod)))))
+ ((pair? e)
+ (let ((first (car e)))
+ (call-with-values
+ (lambda () (syntax-type first r w s rib mod #t))
+ (lambda (ftype fval fform fe fw fs fmod)
+ (let ((key ftype))
+ (cond ((memv key '(lexical)) (values 'lexical-call fval
e e w s mod))
+ ((memv key '(global))
+ (values 'global-call (make-syntax-object fval w
fmod) e e w s mod))
+ ((memv key '(macro))
+ (syntax-type
+ (expand-macro fval e r w s rib mod)
+ r
+ '(())
+ s
+ rib
+ mod
+ for-car?))
+ ((memv key '(module-ref))
(call-with-values
- (lambda ()
- (syntax-type-4296
- e-19766
- r-19463
- w-19464
- (let ((props-19776
- (source-properties
- (if (if (vector? e-19766)
- (if (= (vector-length
- e-19766)
- 4)
- (eq? (vector-ref
- e-19766
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-19766 1)
- e-19766))))
- (if (pair? props-19776) props-19776 #f))
- #f
- mod-19466
- #f))
- (lambda (type-19799
- value-19800
- form-19801
- e-19802
- w-19803
- s-19804
- mod-19805)
- (expand-expr-4298
- type-19799
- value-19800
- form-19801
- e-19802
- r-19463
- w-19803
- s-19804
- mod-19805))))
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466)
- (if (eqv? type-19459 'begin-form)
- (let ((tmp-19815
- ($sc-dispatch e-19462 '(_ any . each-any))))
- (if tmp-19815
- (@apply
- (lambda (e1-19819 e2-19820)
- (expand-sequence-4292
- (cons e1-19819 e2-19820)
- r-19463
- w-19464
- s-19465
- mod-19466))
- tmp-19815)
- (let ((tmp-19947 ($sc-dispatch e-19462 '(_))))
- (if tmp-19947
- (@apply
- (lambda ()
- (if (include-deprecated-features)
- (begin
- (issue-deprecation-warning
- "Sequences of zero expressions
are deprecated. Use *unspecified*.")
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- #f))
+ (lambda () (fval e r w))
+ (lambda (e r w s mod) (syntax-type e r w s rib
mod for-car?))))
+ ((memv key '(core)) (values 'core-form fval e e w
s mod))
+ ((memv key '(local-syntax))
+ (values 'local-syntax-form fval e e w s mod))
+ ((memv key '(begin)) (values 'begin-form #f e e w
s mod))
+ ((memv key '(eval-when)) (values 'eval-when-form
#f e e w s mod))
+ ((memv key '(define))
+ (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any
any))))
+ (if (and tmp-1 (apply (lambda (name val) (id?
name)) tmp-1))
+ (apply (lambda (name val) (values
'define-form name e val w s mod))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_ (any .
any) any . each-any))))
+ (if (and tmp-1
+ (apply (lambda (name args e1 e2)
+ (and (id? name)
(valid-bound-ids? (lambda-var-list args))))
+ tmp-1))
+ (apply (lambda (name args e1 e2)
+ (values
+ 'define-form
+ (wrap name w mod)
+ (wrap e w mod)
+ (decorate-source
+ (cons '#(syntax-object
lambda ((top)) (hygiene guile))
+ (wrap (cons args (cons
e1 e2)) w mod))
+ s)
+ '(())
+ s
+ mod))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_ any))))
+ (if (and tmp-1 (apply (lambda (name)
(id? name)) tmp-1))
+ (apply (lambda (name)
+ (values
+ 'define-form
+ (wrap name w mod)
+ (wrap e w mod)
+ '(#(syntax-object if
((top)) (hygiene guile)) #f #f)
+ '(())
+ s
+ mod))
+ tmp-1)
(syntax-violation
#f
- "sequence of zero expressions"
- (wrap-4290
- (begin
- (if (if s-19465
-
(supports-source-properties?
- e-19462)
- #f)
- (set-source-properties!
- e-19462
- s-19465))
- e-19462)
- w-19464
- mod-19466))))
- tmp-19947)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e-19462)))))
- (if (eqv? type-19459 'local-syntax-form)
- (expand-local-syntax-4302
- value-19460
- e-19462
- r-19463
- w-19464
- s-19465
- mod-19466
- expand-sequence-4292)
- (if (eqv? type-19459 'eval-when-form)
- (let ((tmp-20059
- ($sc-dispatch
- e-19462
- '(_ each-any any . each-any))))
- (if tmp-20059
- (@apply
- (lambda (x-20063 e1-20064 e2-20065)
- (let ((when-list-20066
- (parse-when-list-4295
- e-19462
- x-20063)))
- (if (memq 'eval when-list-20066)
- (expand-sequence-4292
- (cons e1-20064 e2-20065)
- r-19463
- w-19464
- s-19465
- mod-19466)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- #f))))
- tmp-20059)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e-19462)))
- (if (if (eqv? type-19459 'define-form)
- #t
- (if (eqv? type-19459 'define-syntax-form)
- #t
- (eqv? type-19459
- 'define-syntax-parameter-form)))
+ "source expression failed to match
any pattern"
+ tmp))))))))
+ ((memv key '(define-syntax))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any
any))))
+ (if (and tmp (apply (lambda (name val) (id?
name)) tmp))
+ (apply (lambda (name val) (values
'define-syntax-form name e val w s mod))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1))))
+ ((memv key '(define-syntax-parameter))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any
any))))
+ (if (and tmp (apply (lambda (name val) (id?
name)) tmp))
+ (apply (lambda (name val)
+ (values
'define-syntax-parameter-form name e val w s mod))
+ tmp)
(syntax-violation
#f
- "definition in expression context, where
definitions are not allowed,"
- (wrap-4290
- (begin
- (if (if s-19465
- (supports-source-properties?
- form-19461)
- #f)
- (set-source-properties!
- form-19461
- s-19465))
- form-19461)
- w-19464
- mod-19466))
- (if (eqv? type-19459 'syntax)
+ "source expression failed to match any
pattern"
+ tmp-1))))
+ (else (values 'call #f e e w s mod))))))))
+ ((syntax-object? e)
+ (syntax-type
+ (syntax-object-expression e)
+ r
+ (join-wraps w (syntax-object-wrap e))
+ (or (source-annotation e) s)
+ rib
+ (or (syntax-object-module e) mod)
+ for-car?))
+ ((self-evaluating? e) (values 'constant #f e e w s mod))
+ (else (values 'other #f e e w s mod)))))
+ (expand
+ (lambda (e r w mod)
+ (call-with-values
+ (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
+ (lambda (type value form e w s mod)
+ (expand-expr type value form e r w s mod)))))
+ (expand-expr
+ (lambda (type value form e r w s mod)
+ (let ((key type))
+ (cond ((memv key '(lexical)) (build-lexical-reference 'value s e
value))
+ ((memv key '(core core-form)) (value e r w s mod))
+ ((memv key '(module-ref))
+ (call-with-values
+ (lambda () (value e r w))
+ (lambda (e r w s mod) (expand e r w mod))))
+ ((memv key '(lexical-call))
+ (expand-application
+ (let ((id (car e)))
+ (build-lexical-reference
+ 'fun
+ (source-annotation id)
+ (if (syntax-object? id) (syntax->datum id) id)
+ value))
+ e
+ r
+ w
+ s
+ mod))
+ ((memv key '(global-call))
+ (expand-application
+ (build-global-reference
+ (source-annotation (car e))
+ (if (syntax-object? value) (syntax-object-expression
value) value)
+ (if (syntax-object? value) (syntax-object-module value)
mod))
+ e
+ r
+ w
+ s
+ mod))
+ ((memv key '(constant))
+ (build-data s (strip (source-wrap e w s mod) '(()))))
+ ((memv key '(global)) (build-global-reference s value mod))
+ ((memv key '(call))
+ (expand-application (expand (car e) r w mod) e r w s mod))
+ ((memv key '(begin-form))
+ (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any . each-any))))
+ (if tmp-1
+ (apply (lambda (e1 e2) (expand-sequence (cons e1 e2) r w s
mod))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_))))
+ (if tmp-1
+ (apply (lambda ()
+ (if (include-deprecated-features)
+ (begin
+ (issue-deprecation-warning
+ "Sequences of zero expressions are
deprecated. Use *unspecified*.")
+ (expand-void))
(syntax-violation
#f
- "reference to pattern variable outside
syntax form"
- (wrap-4290
- (begin
- (if (if s-19465
- (supports-source-properties?
- e-19462)
- #f)
- (set-source-properties!
- e-19462
- s-19465))
- e-19462)
- w-19464
- mod-19466))
- (if (eqv? type-19459 'displaced-lexical)
- (syntax-violation
- #f
- "reference to identifier outside its
scope"
- (wrap-4290
- (begin
- (if (if s-19465
- (supports-source-properties?
- e-19462)
- #f)
- (set-source-properties!
- e-19462
- s-19465))
- e-19462)
- w-19464
- mod-19466))
- (syntax-violation
- #f
- "unexpected syntax"
- (wrap-4290
- (begin
- (if (if s-19465
- (supports-source-properties?
- e-19462)
- #f)
- (set-source-properties!
- e-19462
- s-19465))
- e-19462)
- w-19464
- mod-19466))))))))))))))))))
- (expand-application-4299
- (lambda (x-20375
- e-20376
- r-20377
- w-20378
- s-20379
- mod-20380)
- (let ((tmp-20382
- ($sc-dispatch e-20376 '(any . each-any))))
- (if tmp-20382
- (@apply
- (lambda (e0-20386 e1-20387)
- (let ((arg-exps-20393
- (map (lambda (e-20398)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-20398
- r-20377
- w-20378
- (let ((props-20413
- (source-properties
- (if (if (vector? e-20398)
- (if (= (vector-length
- e-20398)
- 4)
- (eq? (vector-ref
- e-20398
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref e-20398 1)
- e-20398))))
- (if (pair? props-20413)
- props-20413
- #f))
- #f
- mod-20380
- #f))
- (lambda (type-20446
- value-20447
- form-20448
- e-20449
- w-20450
- s-20451
- mod-20452)
- (expand-expr-4298
- type-20446
- value-20447
- form-20448
- e-20449
- r-20377
- w-20450
- s-20451
- mod-20452))))
- e1-20387)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- s-20379
- x-20375
- arg-exps-20393)))
- tmp-20382)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-20376)))))
- (expand-macro-4300
- (lambda (p-20462
- e-20463
- r-20464
- w-20465
- s-20466
- rib-20467
- mod-20468)
- (letrec*
- ((rebuild-macro-output-20469
- (lambda (x-20502 m-20503)
- (if (pair? x-20502)
- (let ((e-20507
- (cons (rebuild-macro-output-20469
- (car x-20502)
- m-20503)
- (rebuild-macro-output-20469
- (cdr x-20502)
- m-20503))))
- (begin
- (if (if s-20466
- (supports-source-properties? e-20507)
- #f)
- (set-source-properties! e-20507 s-20466))
- e-20507))
- (if (if (vector? x-20502)
- (if (= (vector-length x-20502) 4)
- (eq? (vector-ref x-20502 0) 'syntax-object)
- #f)
- #f)
- (let ((w-20523 (vector-ref x-20502 2)))
- (let ((ms-20524 (car w-20523))
- (ss-20525 (cdr w-20523)))
- (if (if (pair? ms-20524) (eq? (car ms-20524) #f) #f)
- (let ((expression-20533 (vector-ref x-20502 1))
- (wrap-20534
- (cons (cdr ms-20524)
- (if rib-20467
- (cons rib-20467 (cdr ss-20525))
- (cdr ss-20525))))
- (module-20535 (vector-ref x-20502 3)))
- (vector
- 'syntax-object
- expression-20533
- wrap-20534
- module-20535))
- (let ((expression-20545
- (let ((e-20550 (vector-ref x-20502 1)))
- (begin
- (if (if s-20466
- (supports-source-properties?
- e-20550)
- #f)
- (set-source-properties!
- e-20550
- s-20466))
- e-20550)))
- (wrap-20546
- (cons (cons m-20503 ms-20524)
- (if rib-20467
- (cons rib-20467
- (cons 'shift ss-20525))
- (cons 'shift ss-20525))))
- (module-20547 (vector-ref x-20502 3)))
- (vector
- 'syntax-object
- expression-20545
- wrap-20546
- module-20547)))))
- (if (vector? x-20502)
- (let ((n-20562 (vector-length x-20502)))
- (let ((v-20563
- (let ((e-20571 (make-vector n-20562)))
- (begin
- (if (if s-20466
- (supports-source-properties? e-20571)
- #f)
- (set-source-properties! e-20571 s-20466))
- e-20571))))
- (letrec*
- ((loop-20564
- (lambda (i-20616)
- (if (= i-20616 n-20562)
- v-20563
- (begin
- (vector-set!
- v-20563
- i-20616
- (rebuild-macro-output-20469
- (vector-ref x-20502 i-20616)
- m-20503))
- (loop-20564 (#{1+}# i-20616)))))))
- (loop-20564 0))))
- (if (symbol? x-20502)
- (syntax-violation
- #f
- "encountered raw symbol in macro output"
- (let ((s-20622 (cdr w-20465)))
- (wrap-4290
- (begin
- (if (if s-20622
- (supports-source-properties? e-20463)
- #f)
- (set-source-properties! e-20463 s-20622))
- e-20463)
- w-20465
- mod-20468))
- x-20502)
- (begin
- (if (if s-20466
- (supports-source-properties? x-20502)
- #f)
- (set-source-properties! x-20502 s-20466))
- x-20502))))))))
- (with-fluids
- ((transformer-environment-4283
- (lambda (k-20470)
- (k-20470
- e-20463
- r-20464
- w-20465
- s-20466
- rib-20467
- mod-20468))))
- (rebuild-macro-output-20469
- (p-20462
- (let ((w-20477
- (cons (cons #f (car w-20465))
- (cons 'shift (cdr w-20465)))))
- (wrap-4290
- (begin
- (if (if s-20466
- (supports-source-properties? e-20463)
- #f)
- (set-source-properties! e-20463 s-20466))
- e-20463)
- w-20477
- mod-20468)))
- (gensym
- (string-append "m-" (session-id-4222) "-")))))))
- (expand-body-4301
- (lambda (body-20654
- outer-form-20655
- r-20656
- w-20657
- mod-20658)
- (let ((r-20659
- (cons '("placeholder" placeholder) r-20656)))
- (let ((ribcage-20660 (vector 'ribcage '() '() '())))
- (let ((w-20661
- (cons (car w-20657)
- (cons ribcage-20660 (cdr w-20657)))))
- (letrec*
- ((parse-20662
- (lambda (body-20675
- ids-20676
- labels-20677
- var-ids-20678
- vars-20679
- vals-20680
- bindings-20681)
- (if (null? body-20675)
- (syntax-violation
- #f
- "no expressions in body"
- outer-form-20655)
- (let ((e-20682 (cdr (car body-20675)))
- (er-20683 (car (car body-20675))))
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-20682
- er-20683
- '(())
- (let ((props-20692
- (source-properties
- (if (if (vector? er-20683)
- (if (= (vector-length er-20683)
- 4)
- (eq? (vector-ref er-20683 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref er-20683 1)
- er-20683))))
- (if (pair? props-20692) props-20692 #f))
- ribcage-20660
- mod-20658
- #f))
- (lambda (type-20715
- value-20716
- form-20717
- e-20718
- w-20719
- s-20720
- mod-20721)
- (if (eqv? type-20715 'define-form)
- (let ((id-20729
- (wrap-4290
- value-20716
- w-20719
- mod-20721))
- (label-20730
- (string-append
- "l-"
- (session-id-4222)
- (symbol->string (gensym "-")))))
- (let ((var-20731
- (let ((id-20791
- (if (if (vector? id-20729)
- (if (= (vector-length
- id-20729)
- 4)
- (eq? (vector-ref
- id-20729
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-20729 1)
- id-20729)))
- (gensym
- (string-append
- (symbol->string id-20791)
- "-")))))
- (begin
- (let ((update-20781
- (cons (vector-ref id-20729 1)
- (vector-ref
- ribcage-20660
- 1))))
- (vector-set!
- ribcage-20660
- 1
- update-20781))
- (let ((update-20783
- (cons (car (vector-ref
- id-20729
- 2))
- (vector-ref
- ribcage-20660
- 2))))
- (vector-set!
- ribcage-20660
- 2
- update-20783))
- (let ((update-20785
- (cons label-20730
- (vector-ref
- ribcage-20660
- 3))))
- (vector-set!
- ribcage-20660
- 3
- update-20785))
- (parse-20662
- (cdr body-20675)
- (cons id-20729 ids-20676)
- (cons label-20730 labels-20677)
- (cons id-20729 var-ids-20678)
- (cons var-20731 vars-20679)
- (cons (cons er-20683
- (wrap-4290
- e-20718
- w-20719
- mod-20721))
- vals-20680)
- (cons (cons 'lexical var-20731)
- bindings-20681)))))
- (if (if (eqv? type-20715 'define-syntax-form)
- #t
- (eqv? type-20715
- 'define-syntax-parameter-form))
- (let ((id-20827
- (wrap-4290
- value-20716
- w-20719
- mod-20721))
- (label-20828
- (string-append
- "l-"
- (session-id-4222)
- (symbol->string (gensym "-")))))
- (begin
- (let ((update-20878
- (cons (vector-ref id-20827 1)
- (vector-ref
- ribcage-20660
- 1))))
- (vector-set!
- ribcage-20660
- 1
- update-20878))
- (let ((update-20880
- (cons (car (vector-ref
- id-20827
- 2))
- (vector-ref
- ribcage-20660
- 2))))
- (vector-set!
- ribcage-20660
- 2
- update-20880))
- (let ((update-20882
- (cons label-20828
- (vector-ref
- ribcage-20660
- 3))))
- (vector-set!
- ribcage-20660
- 3
- update-20882))
- (parse-20662
- (cdr body-20675)
- (cons id-20827 ids-20676)
- (cons label-20828 labels-20677)
- var-ids-20678
- vars-20679
- vals-20680
- (cons (cons 'macro
- (cons er-20683
- (wrap-4290
- e-20718
- w-20719
- mod-20721)))
- bindings-20681))))
- (if (eqv? type-20715 'begin-form)
- (let ((tmp-20893
- ($sc-dispatch
- e-20718
- '(_ . each-any))))
- (if tmp-20893
- (@apply
- (lambda (e1-20897)
- (parse-20662
- (letrec*
- ((f-20898
- (lambda (forms-20961)
- (if (null? forms-20961)
- (cdr body-20675)
- (cons (cons er-20683
- (wrap-4290
- (car
forms-20961)
- w-20719
-
mod-20721))
- (f-20898
- (cdr
forms-20961)))))))
- (f-20898 e1-20897))
- ids-20676
- labels-20677
- var-ids-20678
- vars-20679
- vals-20680
- bindings-20681))
- tmp-20893)
- (syntax-violation
- #f
- "source expression failed to match
any pattern"
- e-20718)))
- (if (eqv? type-20715 'local-syntax-form)
- (expand-local-syntax-4302
- value-20716
- e-20718
- er-20683
- w-20719
- s-20720
- mod-20721
- (lambda (forms-20978
- er-20979
- w-20980
- s-20981
- mod-20982)
- (parse-20662
- (letrec*
- ((f-20983
- (lambda (forms-21046)
- (if (null? forms-21046)
- (cdr body-20675)
- (cons (cons er-20979
- (wrap-4290
- (car
forms-21046)
- w-20980
- mod-20982))
- (f-20983
- (cdr
forms-21046)))))))
- (f-20983 forms-20978))
- ids-20676
- labels-20677
- var-ids-20678
- vars-20679
- vals-20680
- bindings-20681)))
- (if (null? ids-20676)
- (let ((exps-21053
- (map (lambda (x-21054)
- (let ((e-21057
- (cdr x-21054))
- (r-21058
- (car x-21054)))
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-21057
- r-21058
- '(())
- (let
((props-21065
-
(source-properties
- (if
(if (vector?
-
e-21057)
-
(if (= (vector-length
-
e-21057)
-
4)
-
(eq? (vector-ref
-
e-21057
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-21057
- 1)
-
e-21057))))
- (if (pair?
props-21065)
- props-21065
- #f))
- #f
- mod-20721
- #f))
- (lambda (type-21088
- value-21089
- form-21090
- e-21091
- w-21092
- s-21093
- mod-21094)
- (expand-expr-4298
- type-21088
- value-21089
- form-21090
- e-21091
- r-21058
- w-21092
- s-21093
- mod-21094)))))
- (cons (cons er-20683
- (wrap-4290
- (begin
- (if (if
s-20720
-
(supports-source-properties?
-
e-20718)
- #f)
-
(set-source-properties!
-
e-20718
-
s-20720))
- e-20718)
- w-20719
- mod-20721))
- (cdr body-20675)))))
- (if (null? (cdr exps-21053))
- (car exps-21053)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 12)
- #f
- exps-21053)))
- (begin
- (if (not (valid-bound-ids?-4287
- ids-20676))
- (syntax-violation
- #f
- "invalid or duplicate identifier
in definition"
- outer-form-20655))
- (letrec*
- ((loop-21197
- (lambda (bs-21200
- er-cache-21201
- r-cache-21202)
- (if (not (null? bs-21200))
- (let ((b-21203
- (car bs-21200)))
- (if (eq? (car b-21203)
- 'macro)
- (let ((er-21205
- (car (cdr
b-21203))))
- (let ((r-cache-21206
- (if (eq?
er-21205
-
er-cache-21201)
-
r-cache-21202
-
(macros-only-env-4257
-
er-21205))))
- (begin
- (set-cdr!
- b-21203
-
(eval-local-transformer-4303
- (let ((e-21249
- (cdr
(cdr b-21203))))
-
(call-with-values
- (lambda ()
-
(syntax-type-4296
-
e-21249
-
r-cache-21206
- '(())
- (let
((props-21259
-
(source-properties
-
(if (if (vector?
-
e-21249)
-
(if (= (vector-length
-
e-21249)
-
4)
-
(eq? (vector-ref
-
e-21249
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-21249
-
1)
-
e-21249))))
- (if
(pair? props-21259)
-
props-21259
-
#f))
- #f
-
mod-20721
- #f))
- (lambda
(type-21282
-
value-21283
-
form-21284
-
e-21285
-
w-21286
-
s-21287
-
mod-21288)
-
(expand-expr-4298
-
type-21282
-
value-21283
-
form-21284
-
e-21285
-
r-cache-21206
-
w-21286
-
s-21287
-
mod-21288))))
- mod-20721))
- (loop-21197
- (cdr bs-21200)
- er-21205
-
r-cache-21206))))
- (loop-21197
- (cdr bs-21200)
- er-cache-21201
- r-cache-21202)))))))
- (loop-21197 bindings-20681 #f #f))
- (set-cdr!
- r-20659
- (extend-env-4255
- labels-20677
- bindings-20681
- (cdr r-20659)))
- (let ((ids-21471
- (reverse
- (map syntax->datum
- var-ids-20678)))
- (vars-21472
- (reverse vars-20679))
- (val-exps-21473
- (map (lambda (x-21560)
- (let ((e-21563
- (cdr x-21560))
- (r-21564
- (car
x-21560)))
- (call-with-values
- (lambda ()
-
(syntax-type-4296
- e-21563
- r-21564
- '(())
- (let
((props-21571
-
(source-properties
- (if
(if (vector?
-
e-21563)
-
(if (= (vector-length
-
e-21563)
-
4)
-
(eq? (vector-ref
-
e-21563
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-21563
-
1)
-
e-21563))))
- (if (pair?
props-21571)
-
props-21571
- #f))
- #f
- mod-20721
- #f))
- (lambda
(type-21594
-
value-21595
-
form-21596
- e-21597
- w-21598
- s-21599
-
mod-21600)
-
(expand-expr-4298
- type-21594
- value-21595
- form-21596
- e-21597
- r-21564
- w-21598
- s-21599
- mod-21600)))))
- (reverse vals-20680)))
- (body-exp-21474
- (let ((exps-21478
- (map (lambda
(x-21479)
- (let ((e-21482
- (cdr
x-21479))
- (r-21483
- (car
x-21479)))
-
(call-with-values
- (lambda ()
-
(syntax-type-4296
-
e-21482
-
r-21483
- '(())
- (let
((props-21490
-
(source-properties
-
(if (if (vector?
-
e-21482)
-
(if (= (vector-length
-
e-21482)
-
4)
-
(eq? (vector-ref
-
e-21482
-
0)
-
'syntax-object)
-
#f)
-
#f)
-
(vector-ref
-
e-21482
-
1)
-
e-21482))))
- (if
(pair? props-21490)
-
props-21490
-
#f))
- #f
-
mod-20721
- #f))
- (lambda
(type-21513
-
value-21514
-
form-21515
-
e-21516
-
w-21517
-
s-21518
-
mod-21519)
-
(expand-expr-4298
-
type-21513
-
value-21514
-
form-21515
-
e-21516
-
r-21483
-
w-21517
-
s-21518
-
mod-21519)))))
- (cons (cons
er-20683
-
(wrap-4290
-
(begin
-
(if (if s-20720
-
(supports-source-properties?
-
e-20718)
-
#f)
-
(set-source-properties!
-
e-20718
-
s-20720))
-
e-20718)
-
w-20719
-
mod-20721))
- (cdr
body-20675)))))
- (if (null? (cdr
exps-21478))
- (car exps-21478)
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 12)
- #f
- exps-21478)))))
- (if (null? vars-21472)
- body-exp-21474
- (begin
- (for-each
- maybe-name-value!-4226
- ids-21471
- val-exps-21473)
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 16)
- #f
- #t
- ids-21471
- vars-21472
- val-exps-21473
-
body-exp-21474)))))))))))))))))
- (parse-20662
- (map (lambda (x-20665)
- (cons r-20659
- (wrap-4290 x-20665 w-20661 mod-20658)))
- body-20654)
- '()
- '()
- '()
- '()
- '()
- '())))))))
- (expand-local-syntax-4302
- (lambda (rec?-21610
- e-21611
- r-21612
- w-21613
- s-21614
- mod-21615
- k-21616)
- (let ((tmp-21618
- ($sc-dispatch
- e-21611
- '(_ #(each (any any)) any . each-any))))
- (if tmp-21618
- (@apply
- (lambda (id-21620 val-21621 e1-21622 e2-21623)
- (if (not (valid-bound-ids?-4287 id-21620))
- (syntax-violation
- #f
- "duplicate bound keyword"
- e-21611)
- (let ((labels-21713 (gen-labels-4264 id-21620)))
- (let ((new-w-21714
- (make-binding-wrap-4275
- id-21620
- labels-21713
- w-21613)))
- (k-21616
- (cons e1-21622 e2-21623)
- (extend-env-4255
- labels-21713
- (let ((trans-r-21750
- (macros-only-env-4257 r-21612)))
- (begin
- (if rec?-21610 new-w-21714 w-21613)
- (map (lambda (x-21751)
- (cons 'macro
- (eval-local-transformer-4303
- (call-with-values
- (lambda ()
- (syntax-type-4296
- x-21751
- trans-r-21750
- (values
- (if rec?-21610
- new-w-21714
- w-21613))
- (let ((props-21811
- (source-properties
- (if (if (vector?
-
x-21751)
- (if (=
(vector-length
-
x-21751)
- 4)
- (eq?
(vector-ref
-
x-21751
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- x-21751
- 1)
- x-21751))))
- (if (pair? props-21811)
- props-21811
- #f))
- #f
- mod-21615
- #f))
- (lambda (type-21844
- value-21845
- form-21846
- e-21847
- w-21848
- s-21849
- mod-21850)
- (expand-expr-4298
- type-21844
- value-21845
- form-21846
- e-21847
- trans-r-21750
- w-21848
- s-21849
- mod-21850)))
- mod-21615)))
- val-21621)))
- r-21612)
- new-w-21714
- s-21614
- mod-21615)))))
- tmp-21618)
- (syntax-violation
- #f
- "bad local syntax definition"
- (wrap-4290
- (begin
- (if (if s-21614
- (supports-source-properties? e-21611)
- #f)
- (set-source-properties! e-21611 s-21614))
- e-21611)
- w-21613
- mod-21615))))))
- (eval-local-transformer-4303
- (lambda (expanded-22016 mod-22017)
- (let ((p-22018 (primitive-eval expanded-22016)))
- (if (procedure? p-22018)
- p-22018
- (syntax-violation
- #f
- "nonprocedure transformer"
- p-22018)))))
- (ellipsis?-4305
- (lambda (x-4941)
- (if (if (if (vector? x-4941)
- (if (= (vector-length x-4941) 4)
- (eq? (vector-ref x-4941 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-4941 1))
- #f)
- (if (eq? (if (if (vector? x-4941)
- (if (= (vector-length x-4941) 4)
- (eq? (vector-ref x-4941 0) 'syntax-object)
- #f)
- #f)
- (vector-ref x-4941 1)
- x-4941)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280 x-4941 '(()))
- (id-var-name-4280
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- #f)))
- (lambda-formals-4306
- (lambda (orig-args-22023)
- (letrec*
- ((req-22024
- (lambda (args-22028 rreq-22029)
- (let ((tmp-22031 ($sc-dispatch args-22028 '())))
- (if tmp-22031
- (@apply
- (lambda () (check-22025 (reverse rreq-22029) #f))
- tmp-22031)
- (let ((tmp-22154
- ($sc-dispatch args-22028 '(any . any))))
- (if (if tmp-22154
- (@apply
- (lambda (a-22158 b-22159)
- (if (symbol? a-22158)
- #t
- (if (if (vector? a-22158)
- (if (= (vector-length a-22158) 4)
- (eq? (vector-ref a-22158 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-22158 1))
- #f)))
- tmp-22154)
- #f)
- (@apply
- (lambda (a-22186 b-22187)
- (req-22024 b-22187 (cons a-22186 rreq-22029)))
- tmp-22154)
- (let ((tmp-22188 (list args-22028)))
- (if (@apply
- (lambda (r-22190)
- (if (symbol? r-22190)
- #t
- (if (if (vector? r-22190)
- (if (= (vector-length r-22190) 4)
- (eq? (vector-ref r-22190 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref r-22190 1))
- #f)))
- tmp-22188)
- (@apply
- (lambda (r-22220)
- (check-22025 (reverse rreq-22029) r-22220))
- tmp-22188)
- (syntax-violation
- 'lambda
- "invalid argument list"
- orig-args-22023
- args-22028)))))))))
- (check-22025
- (lambda (req-22351 rest-22352)
- (if (distinct-bound-ids?-4288
- (if rest-22352
- (cons rest-22352 req-22351)
- req-22351))
- (values req-22351 #f rest-22352 #f)
- (syntax-violation
- 'lambda
- "duplicate identifier in argument list"
- orig-args-22023)))))
- (req-22024 orig-args-22023 '()))))
- (expand-simple-lambda-4307
- (lambda (e-22468
- r-22469
- w-22470
- s-22471
- mod-22472
- req-22473
- rest-22474
- meta-22475
- body-22476)
- (let ((ids-22477
- (if rest-22474
- (append req-22473 (list rest-22474))
- req-22473)))
- (let ((vars-22478 (map gen-var-4311 ids-22477)))
- (let ((labels-22479 (gen-labels-4264 ids-22477)))
- (build-simple-lambda-4237
- s-22471
- (map syntax->datum req-22473)
- (if rest-22474 (syntax->datum rest-22474) #f)
- vars-22478
- meta-22475
- (expand-body-4301
- body-22476
- (wrap-4290
- (begin
- (if (if s-22471
- (supports-source-properties? e-22468)
- #f)
- (set-source-properties! e-22468 s-22471))
- e-22468)
- w-22470
- mod-22472)
- (extend-var-env-4256
- labels-22479
- vars-22478
- r-22469)
- (make-binding-wrap-4275
- ids-22477
- labels-22479
- w-22470)
- mod-22472)))))))
- (lambda*-formals-4308
- (lambda (orig-args-22759)
- (letrec*
- ((req-22760
- (lambda (args-22767 rreq-22768)
- (let ((tmp-22770 ($sc-dispatch args-22767 '())))
- (if tmp-22770
- (@apply
- (lambda ()
- (check-22764 (reverse rreq-22768) '() #f '()))
- tmp-22770)
- (let ((tmp-22776
- ($sc-dispatch args-22767 '(any . any))))
- (if (if tmp-22776
- (@apply
- (lambda (a-22780 b-22781)
- (if (symbol? a-22780)
- #t
- (if (if (vector? a-22780)
- (if (= (vector-length a-22780) 4)
- (eq? (vector-ref a-22780 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-22780 1))
- #f)))
- tmp-22776)
- #f)
- (@apply
- (lambda (a-22808 b-22809)
- (req-22760 b-22809 (cons a-22808 rreq-22768)))
- tmp-22776)
- (let ((tmp-22810
- ($sc-dispatch args-22767 '(any . any))))
- (if (if tmp-22810
- (@apply
- (lambda (a-22814 b-22815)
- (eq? (syntax->datum a-22814) #:optional))
- tmp-22810)
- #f)
- (@apply
- (lambda (a-22816 b-22817)
- (opt-22761 b-22817 (reverse rreq-22768) '()))
- tmp-22810)
- (let ((tmp-22820
- ($sc-dispatch args-22767 '(any . any))))
- (if (if tmp-22820
- (@apply
- (lambda (a-22824 b-22825)
- (eq? (syntax->datum a-22824) #:key))
- tmp-22820)
- #f)
- (@apply
- (lambda (a-22826 b-22827)
- (key-22762
- b-22827
- (reverse rreq-22768)
- '()
- '()))
- tmp-22820)
- (let ((tmp-22830
- ($sc-dispatch args-22767 '(any any))))
- (if (if tmp-22830
- (@apply
- (lambda (a-22834 b-22835)
- (eq? (syntax->datum a-22834)
- #:rest))
- tmp-22830)
- #f)
- (@apply
- (lambda (a-22836 b-22837)
- (rest-22763
- b-22837
- (reverse rreq-22768)
- '()
- '()))
- tmp-22830)
- (let ((tmp-22840 (list args-22767)))
- (if (@apply
- (lambda (r-22842)
- (if (symbol? r-22842)
- #t
- (if (if (vector? r-22842)
- (if (= (vector-length
- r-22842)
- 4)
- (eq? (vector-ref
- r-22842
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref r-22842 1))
- #f)))
- tmp-22840)
- (@apply
- (lambda (r-22872)
- (rest-22763
- r-22872
- (reverse rreq-22768)
- '()
- '()))
- tmp-22840)
- (syntax-violation
- 'lambda*
- "invalid argument list"
- orig-args-22759
- args-22767)))))))))))))))
- (opt-22761
- (lambda (args-22891 req-22892 ropt-22893)
- (let ((tmp-22895 ($sc-dispatch args-22891 '())))
- (if tmp-22895
- (@apply
- (lambda ()
- (check-22764
- req-22892
- (reverse ropt-22893)
- #f
- '()))
- tmp-22895)
- (let ((tmp-22901
- ($sc-dispatch args-22891 '(any . any))))
- (if (if tmp-22901
- (@apply
- (lambda (a-22905 b-22906)
- (if (symbol? a-22905)
- #t
- (if (if (vector? a-22905)
- (if (= (vector-length a-22905) 4)
- (eq? (vector-ref a-22905 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-22905 1))
- #f)))
- tmp-22901)
- #f)
- (@apply
- (lambda (a-22933 b-22934)
- (opt-22761
- b-22934
- req-22892
- (cons (cons a-22933
- '(#(syntax-object
- #f
- ((top)
- #(ribcage
- #(a b)
- #((top) (top))
- #("l-*-2402" "l-*-2403"))
- #(ribcage () () ())
- #(ribcage
- #(args req ropt)
- #((top) (top) (top))
- #("l-*-2392"
- "l-*-2393"
- "l-*-2394"))
- #(ribcage
- (check rest key opt req)
- ((top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-2338"
- "l-*-2336"
- "l-*-2334"
- "l-*-2332"
- "l-*-2330"))
- #(ribcage
- #(orig-args)
- #((top))
- #("l-*-2329"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))))
- ropt-22893)))
- tmp-22901)
- (let ((tmp-22935
- ($sc-dispatch args-22891 '((any any) . any))))
- (if (if tmp-22935
- (@apply
- (lambda (a-22939 init-22940 b-22941)
- (if (symbol? a-22939)
- #t
- (if (if (vector? a-22939)
- (if (= (vector-length a-22939) 4)
- (eq? (vector-ref a-22939 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-22939 1))
- #f)))
- tmp-22935)
- #f)
- (@apply
- (lambda (a-22968 init-22969 b-22970)
- (opt-22761
- b-22970
- req-22892
- (cons (list a-22968 init-22969) ropt-22893)))
- tmp-22935)
- (let ((tmp-22971
- ($sc-dispatch args-22891 '(any . any))))
- (if (if tmp-22971
- (@apply
- (lambda (a-22975 b-22976)
- (eq? (syntax->datum a-22975) #:key))
- tmp-22971)
- #f)
- (@apply
- (lambda (a-22977 b-22978)
- (key-22762
- b-22978
- req-22892
- (reverse ropt-22893)
- '()))
- tmp-22971)
- (let ((tmp-22981
- ($sc-dispatch args-22891 '(any any))))
- (if (if tmp-22981
- (@apply
- (lambda (a-22985 b-22986)
- (eq? (syntax->datum a-22985)
- #:rest))
- tmp-22981)
- #f)
- (@apply
- (lambda (a-22987 b-22988)
- (rest-22763
- b-22988
- req-22892
- (reverse ropt-22893)
- '()))
- tmp-22981)
- (let ((tmp-22991 (list args-22891)))
- (if (@apply
- (lambda (r-22993)
- (if (symbol? r-22993)
- #t
- (if (if (vector? r-22993)
- (if (= (vector-length
- r-22993)
- 4)
- (eq? (vector-ref
- r-22993
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref r-22993 1))
- #f)))
- tmp-22991)
- (@apply
- (lambda (r-23023)
- (rest-22763
- r-23023
- req-22892
- (reverse ropt-22893)
- '()))
- tmp-22991)
- (syntax-violation
- 'lambda*
- "invalid optional argument list"
- orig-args-22759
- args-22891)))))))))))))))
- (key-22762
- (lambda (args-23042 req-23043 opt-23044 rkey-23045)
- (let ((tmp-23047 ($sc-dispatch args-23042 '())))
- (if tmp-23047
- (@apply
- (lambda ()
- (check-22764
- req-23043
- opt-23044
- #f
- (cons #f (reverse rkey-23045))))
- tmp-23047)
- (let ((tmp-23053
- ($sc-dispatch args-23042 '(any . any))))
- (if (if tmp-23053
- (@apply
- (lambda (a-23057 b-23058)
- (if (symbol? a-23057)
- #t
- (if (if (vector? a-23057)
- (if (= (vector-length a-23057) 4)
- (eq? (vector-ref a-23057 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-23057 1))
- #f)))
- tmp-23053)
- #f)
- (@apply
- (lambda (a-23085 b-23086)
- (let ((tmp-23087
- (symbol->keyword (syntax->datum a-23085))))
- (key-22762
- b-23086
- req-23043
- opt-23044
- (cons (cons tmp-23087
- (cons a-23085
- '(#(syntax-object
- #f
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(k)
- #((top))
- #("l-*-2465"))
- #(ribcage
- #(a b)
- #((top) (top))
- #("l-*-2459"
- "l-*-2460"))
- #(ribcage () () ())
- #(ribcage
- #(args req opt rkey)
- #((top)
- (top)
- (top)
- (top))
- #("l-*-2448"
- "l-*-2449"
- "l-*-2450"
- "l-*-2451"))
- #(ribcage
- (check rest
- key
- opt
- req)
- ((top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-2338"
- "l-*-2336"
- "l-*-2334"
- "l-*-2332"
- "l-*-2330"))
- #(ribcage
- #(orig-args)
- #((top))
- #("l-*-2329"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile)))))
- rkey-23045))))
- tmp-23053)
- (let ((tmp-23090
- ($sc-dispatch args-23042 '((any any) . any))))
- (if (if tmp-23090
- (@apply
- (lambda (a-23094 init-23095 b-23096)
- (if (symbol? a-23094)
- #t
- (if (if (vector? a-23094)
- (if (= (vector-length a-23094) 4)
- (eq? (vector-ref a-23094 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref a-23094 1))
- #f)))
- tmp-23090)
- #f)
- (@apply
- (lambda (a-23123 init-23124 b-23125)
- (let ((tmp-23126
- (symbol->keyword
- (syntax->datum a-23123))))
- (key-22762
- b-23125
- req-23043
- opt-23044
- (cons (list tmp-23126 a-23123 init-23124)
- rkey-23045))))
- tmp-23090)
- (let ((tmp-23129
- ($sc-dispatch
- args-23042
- '((any any any) . any))))
- (if (if tmp-23129
- (@apply
- (lambda (a-23133
- init-23134
- k-23135
- b-23136)
- (if (if (symbol? a-23133)
- #t
- (if (if (vector? a-23133)
- (if (= (vector-length
- a-23133)
- 4)
- (eq? (vector-ref
- a-23133
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref a-23133 1))
- #f))
- (keyword? (syntax->datum k-23135))
- #f))
- tmp-23129)
- #f)
- (@apply
- (lambda (a-23163 init-23164 k-23165 b-23166)
- (key-22762
- b-23166
- req-23043
- opt-23044
- (cons (list k-23165 a-23163 init-23164)
- rkey-23045)))
- tmp-23129)
- (let ((tmp-23167
- ($sc-dispatch args-23042 '(any))))
- (if (if tmp-23167
- (@apply
- (lambda (aok-23171)
- (eq? (syntax->datum aok-23171)
- #:allow-other-keys))
- tmp-23167)
- #f)
- (@apply
- (lambda (aok-23172)
- (check-22764
- req-23043
- opt-23044
- #f
- (cons #t (reverse rkey-23045))))
- tmp-23167)
- (let ((tmp-23175
- ($sc-dispatch
- args-23042
- '(any any any))))
- (if (if tmp-23175
- (@apply
- (lambda (aok-23179
- a-23180
- b-23181)
- (if (eq? (syntax->datum
- aok-23179)
- #:allow-other-keys)
- (eq? (syntax->datum a-23180)
- #:rest)
- #f))
- tmp-23175)
- #f)
- (@apply
- (lambda (aok-23182 a-23183 b-23184)
- (rest-22763
- b-23184
- req-23043
- opt-23044
- (cons #t (reverse rkey-23045))))
- tmp-23175)
- (let ((tmp-23187
- ($sc-dispatch
- args-23042
- '(any . any))))
- (if (if tmp-23187
- (@apply
- (lambda (aok-23191 r-23192)
- (if (eq? (syntax->datum
- aok-23191)
-
#:allow-other-keys)
- (if (symbol? r-23192)
- #t
- (if (if (vector?
- r-23192)
- (if (=
(vector-length
- r-23192)
- 4)
- (eq?
(vector-ref
- r-23192
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- r-23192
- 1))
- #f))
- #f))
- tmp-23187)
- #f)
- (@apply
- (lambda (aok-23219 r-23220)
- (rest-22763
- r-23220
- req-23043
- opt-23044
- (cons #t
- (reverse rkey-23045))))
- tmp-23187)
- (let ((tmp-23223
- ($sc-dispatch
- args-23042
- '(any any))))
- (if (if tmp-23223
- (@apply
- (lambda (a-23227 b-23228)
- (eq? (syntax->datum
- a-23227)
- #:rest))
- tmp-23223)
- #f)
- (@apply
- (lambda (a-23229 b-23230)
- (rest-22763
- b-23230
- req-23043
- opt-23044
- (cons #f
- (reverse
- rkey-23045))))
- tmp-23223)
- (let ((tmp-23233
- (list args-23042)))
- (if (@apply
- (lambda (r-23235)
- (if (symbol? r-23235)
- #t
- (if (if (vector?
- r-23235)
- (if (=
(vector-length
-
r-23235)
- 4)
- (eq?
(vector-ref
-
r-23235
- 0)
-
'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- r-23235
- 1))
- #f)))
- tmp-23233)
- (@apply
- (lambda (r-23265)
- (rest-22763
- r-23265
- req-23043
- opt-23044
- (cons #f
- (reverse
-
rkey-23045))))
- tmp-23233)
- (syntax-violation
- 'lambda*
- "invalid keyword
argument list"
- orig-args-22759
-
args-23042)))))))))))))))))))))
- (rest-22763
- (lambda (args-23293 req-23294 opt-23295 kw-23296)
- (let ((tmp-23298 (list args-23293)))
- (if (@apply
- (lambda (r-23300)
- (if (symbol? r-23300)
- #t
- (if (if (vector? r-23300)
- (if (= (vector-length r-23300) 4)
- (eq? (vector-ref r-23300 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref r-23300 1))
- #f)))
- tmp-23298)
- (@apply
- (lambda (r-23330)
- (check-22764
- req-23294
- opt-23295
- r-23330
- kw-23296))
- tmp-23298)
- (syntax-violation
- 'lambda*
- "invalid rest argument"
- orig-args-22759
- args-23293)))))
- (check-22764
- (lambda (req-23334 opt-23335 rest-23336 kw-23337)
- (if (distinct-bound-ids?-4288
- (append
- req-23334
- (map car opt-23335)
- (if rest-23336 (list rest-23336) '())
- (if (pair? kw-23337)
- (map cadr (cdr kw-23337))
- '())))
- (values req-23334 opt-23335 rest-23336 kw-23337)
- (syntax-violation
- 'lambda*
- "duplicate identifier in argument list"
- orig-args-22759)))))
- (req-22760 orig-args-22759 '()))))
- (expand-lambda-case-4309
- (lambda (e-23453
- r-23454
- w-23455
- s-23456
- mod-23457
- get-formals-23458
- clauses-23459)
- (letrec*
- ((parse-req-23460
- (lambda (req-23591
- opt-23592
- rest-23593
- kw-23594
- body-23595)
- (let ((vars-23596 (map gen-var-4311 req-23591))
- (labels-23597 (gen-labels-4264 req-23591)))
- (let ((r*-23598
- (extend-var-env-4256
- labels-23597
- vars-23596
- r-23454))
- (w*-23599
- (make-binding-wrap-4275
- req-23591
- labels-23597
- w-23455)))
- (parse-opt-23461
- (map syntax->datum req-23591)
- opt-23592
- rest-23593
- kw-23594
- body-23595
- (reverse vars-23596)
- r*-23598
- w*-23599
- '()
- '())))))
- (parse-opt-23461
- (lambda (req-23785
- opt-23786
- rest-23787
- kw-23788
- body-23789
- vars-23790
- r*-23791
- w*-23792
- out-23793
- inits-23794)
- (if (pair? opt-23786)
- (let ((tmp-23795 (car opt-23786)))
- (let ((tmp-23796 ($sc-dispatch tmp-23795 '(any any))))
- (if tmp-23796
- (@apply
- (lambda (id-23798 i-23799)
- (let ((v-23800
- (let ((id-23808
- (if (if (vector? id-23798)
- (if (= (vector-length
- id-23798)
- 4)
- (eq? (vector-ref
- id-23798
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-23798 1)
- id-23798)))
- (gensym
- (string-append
- (symbol->string id-23808)
- "-")))))
- (let ((l-23801 (gen-labels-4264 (list v-23800))))
- (let ((r**-23802
- (extend-var-env-4256
- l-23801
- (list v-23800)
- r*-23791)))
- (let ((w**-23803
- (make-binding-wrap-4275
- (list id-23798)
- l-23801
- w*-23792)))
- (parse-opt-23461
- req-23785
- (cdr opt-23786)
- rest-23787
- kw-23788
- body-23789
- (cons v-23800 vars-23790)
- r**-23802
- w**-23803
- (cons (syntax->datum id-23798) out-23793)
- (cons (call-with-values
- (lambda ()
- (syntax-type-4296
- i-23799
- r*-23791
- w*-23792
- (let ((props-23882
- (source-properties
- (if (if (vector?
- i-23799)
- (if (=
(vector-length
-
i-23799)
- 4)
- (eq?
(vector-ref
-
i-23799
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- i-23799
- 1)
- i-23799))))
- (if (pair? props-23882)
- props-23882
- #f))
- #f
- mod-23457
- #f))
- (lambda (type-23915
- value-23916
- form-23917
- e-23918
- w-23919
- s-23920
- mod-23921)
- (expand-expr-4298
- type-23915
- value-23916
- form-23917
- e-23918
- r*-23791
- w-23919
- s-23920
- mod-23921)))
- inits-23794)))))))
- tmp-23796)
+ "sequence of zero expressions"
+ (source-wrap e w s mod))))
+ tmp-1)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-23795))))
- (if rest-23787
- (let ((v-24035
- (let ((id-24045
- (if (if (vector? rest-23787)
- (if (= (vector-length rest-23787) 4)
- (eq? (vector-ref rest-23787 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref rest-23787 1)
- rest-23787)))
- (gensym
- (string-append
- (symbol->string id-24045)
- "-")))))
- (let ((l-24036 (gen-labels-4264 (list v-24035))))
- (let ((r*-24037
- (extend-var-env-4256
- l-24036
- (list v-24035)
- r*-23791)))
- (let ((w*-24038
- (make-binding-wrap-4275
- (list rest-23787)
- l-24036
- w*-23792)))
- (parse-kw-23462
- req-23785
- (if (pair? out-23793) (reverse out-23793) #f)
- (syntax->datum rest-23787)
- (if (pair? kw-23788) (cdr kw-23788) kw-23788)
- body-23789
- (cons v-24035 vars-23790)
- r*-24037
- w*-24038
- (if (pair? kw-23788) (car kw-23788) #f)
- '()
- inits-23794)))))
- (parse-kw-23462
- req-23785
- (if (pair? out-23793) (reverse out-23793) #f)
+ tmp))))))
+ ((memv key '(local-syntax-form))
+ (expand-local-syntax value e r w s mod expand-sequence))
+ ((memv key '(eval-when-form))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any .
each-any))))
+ (if tmp
+ (apply (lambda (x e1 e2)
+ (let ((when-list (parse-when-list e x)))
+ (if (memq 'eval when-list)
+ (expand-sequence (cons e1 e2) r w s mod)
+ (expand-void))))
+ tmp)
+ (syntax-violation
#f
- (if (pair? kw-23788) (cdr kw-23788) kw-23788)
- body-23789
- vars-23790
- r*-23791
- w*-23792
- (if (pair? kw-23788) (car kw-23788) #f)
- '()
- inits-23794)))))
- (parse-kw-23462
- (lambda (req-24216
- opt-24217
- rest-24218
- kw-24219
- body-24220
- vars-24221
- r*-24222
- w*-24223
- aok-24224
- out-24225
- inits-24226)
- (if (pair? kw-24219)
- (let ((tmp-24227 (car kw-24219)))
- (let ((tmp-24228
- ($sc-dispatch tmp-24227 '(any any any))))
- (if tmp-24228
- (@apply
- (lambda (k-24230 id-24231 i-24232)
- (let ((v-24233
- (let ((id-24241
- (if (if (vector? id-24231)
- (if (= (vector-length
- id-24231)
- 4)
- (eq? (vector-ref
- id-24231
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-24231 1)
- id-24231)))
- (gensym
- (string-append
- (symbol->string id-24241)
- "-")))))
- (let ((l-24234 (gen-labels-4264 (list v-24233))))
- (let ((r**-24235
- (extend-var-env-4256
- l-24234
- (list v-24233)
- r*-24222)))
- (let ((w**-24236
- (make-binding-wrap-4275
- (list id-24231)
- l-24234
- w*-24223)))
- (parse-kw-23462
- req-24216
- opt-24217
- rest-24218
- (cdr kw-24219)
- body-24220
- (cons v-24233 vars-24221)
- r**-24235
- w**-24236
- aok-24224
- (cons (list (syntax->datum k-24230)
- (syntax->datum id-24231)
- v-24233)
- out-24225)
- (cons (call-with-values
- (lambda ()
- (syntax-type-4296
- i-24232
- r*-24222
- w*-24223
- (let ((props-24315
- (source-properties
- (if (if (vector?
- i-24232)
- (if (=
(vector-length
-
i-24232)
- 4)
- (eq?
(vector-ref
-
i-24232
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- i-24232
- 1)
- i-24232))))
- (if (pair? props-24315)
- props-24315
- #f))
- #f
- mod-23457
- #f))
- (lambda (type-24348
- value-24349
- form-24350
- e-24351
- w-24352
- s-24353
- mod-24354)
- (expand-expr-4298
- type-24348
- value-24349
- form-24350
- e-24351
- r*-24222
- w-24352
- s-24353
- mod-24354)))
- inits-24226)))))))
- tmp-24228)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-24227))))
- (parse-body-23463
- req-24216
- opt-24217
- rest-24218
- (if (if aok-24224 aok-24224 (pair? out-24225))
- (cons aok-24224 (reverse out-24225))
- #f)
- body-24220
- (reverse vars-24221)
- r*-24222
- w*-24223
- (reverse inits-24226)
- '()))))
- (parse-body-23463
- (lambda (req-24477
- opt-24478
- rest-24479
- kw-24480
- body-24481
- vars-24482
- r*-24483
- w*-24484
- inits-24485
- meta-24486)
- (let ((tmp-24488
- ($sc-dispatch body-24481 '(any any . each-any))))
- (if (if tmp-24488
- (@apply
- (lambda (docstring-24492 e1-24493 e2-24494)
- (string? (syntax->datum docstring-24492)))
- tmp-24488)
- #f)
- (@apply
- (lambda (docstring-24495 e1-24496 e2-24497)
- (parse-body-23463
- req-24477
- opt-24478
- rest-24479
- kw-24480
- (cons e1-24496 e2-24497)
- vars-24482
- r*-24483
- w*-24484
- inits-24485
- (append
- meta-24486
- (list (cons 'documentation
- (syntax->datum docstring-24495))))))
- tmp-24488)
- (let ((tmp-24498
- ($sc-dispatch
- body-24481
- '(#(vector #(each (any . any)))
- any
- .
- each-any))))
- (if tmp-24498
- (@apply
- (lambda (k-24502 v-24503 e1-24504 e2-24505)
- (parse-body-23463
- req-24477
- opt-24478
- rest-24479
- kw-24480
- (cons e1-24504 e2-24505)
- vars-24482
- r*-24483
- w*-24484
- inits-24485
- (append
- meta-24486
- (syntax->datum (map cons k-24502 v-24503)))))
- tmp-24498)
- (let ((tmp-24506
- ($sc-dispatch body-24481 '(any . each-any))))
- (if tmp-24506
- (@apply
- (lambda (e1-24510 e2-24511)
- (values
- meta-24486
- req-24477
- opt-24478
- rest-24479
- kw-24480
- inits-24485
- vars-24482
- (expand-body-4301
- (cons e1-24510 e2-24511)
- (wrap-4290
- (begin
- (if (if s-23456
- (supports-source-properties?
- e-23453)
- #f)
- (set-source-properties!
- e-23453
- s-23456))
- e-23453)
- w-23455
- mod-23457)
- r*-24483
- w*-24484
- mod-23457)))
- tmp-24506)
- (syntax-violation
+ "source expression failed to match any pattern"
+ tmp-1))))
+ ((memv key
+ '(define-form define-syntax-form
define-syntax-parameter-form))
+ (syntax-violation
+ #f
+ "definition in expression context, where definitions are not
allowed,"
+ (source-wrap form w s mod)))
+ ((memv key '(syntax))
+ (syntax-violation
+ #f
+ "reference to pattern variable outside syntax form"
+ (source-wrap e w s mod)))
+ ((memv key '(displaced-lexical))
+ (syntax-violation
+ #f
+ "reference to identifier outside its scope"
+ (source-wrap e w s mod)))
+ (else
+ (syntax-violation #f "unexpected syntax" (source-wrap e w s
mod)))))))
+ (expand-application
+ (lambda (x e r w s mod)
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(any . each-any))))
+ (if tmp
+ (apply (lambda (e0 e1)
+ (build-application s x (map (lambda (e) (expand e r w
mod)) e1)))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))
+ (expand-macro
+ (lambda (p e r w s rib mod)
+ (letrec*
+ ((rebuild-macro-output
+ (lambda (x m)
+ (cond ((pair? x)
+ (decorate-source
+ (cons (rebuild-macro-output (car x) m)
+ (rebuild-macro-output (cdr x) m))
+ s))
+ ((syntax-object? x)
+ (let ((w (syntax-object-wrap x)))
+ (let ((ms (car w)) (ss (cdr w)))
+ (if (and (pair? ms) (eq? (car ms) #f))
+ (make-syntax-object
+ (syntax-object-expression x)
+ (cons (cdr ms) (if rib (cons rib (cdr ss)) (cdr
ss)))
+ (syntax-object-module x))
+ (make-syntax-object
+ (decorate-source (syntax-object-expression x) s)
+ (cons (cons m ms)
+ (if rib (cons rib (cons 'shift ss)) (cons
'shift ss)))
+ (syntax-object-module x))))))
+ ((vector? x)
+ (let* ((n (vector-length x)) (v (decorate-source
(make-vector n) s)))
+ (let loop ((i 0))
+ (if (= i n)
+ (begin (if #f #f) v)
+ (begin
+ (vector-set! v i (rebuild-macro-output
(vector-ref x i) m))
+ (loop (+ i 1)))))))
+ ((symbol? x)
+ (syntax-violation
+ #f
+ "encountered raw symbol in macro output"
+ (source-wrap e w (cdr w) mod)
+ x))
+ (else (decorate-source x s))))))
+ (with-fluids
+ ((transformer-environment (lambda (k) (k e r w s rib mod))))
+ (rebuild-macro-output
+ (p (source-wrap e (anti-mark w) s mod))
+ (gensym (string-append "m-" (session-id) "-")))))))
+ (expand-body
+ (lambda (body outer-form r w mod)
+ (let* ((r (cons '("placeholder" placeholder) r))
+ (ribcage (make-ribcage '() '() '()))
+ (w (cons (car w) (cons ribcage (cdr w)))))
+ (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
+ (ids '())
+ (labels '())
+ (var-ids '())
+ (vars '())
+ (vals '())
+ (bindings '()))
+ (if (null? body)
+ (syntax-violation #f "no expressions in body" outer-form)
+ (let ((e (cdar body)) (er (caar body)))
+ (call-with-values
+ (lambda ()
+ (syntax-type e er '(()) (source-annotation er) ribcage mod
#f))
+ (lambda (type value form e w s mod)
+ (let ((key type))
+ (cond ((memv key '(define-form))
+ (let ((id (wrap value w mod)) (label (gen-label)))
+ (let ((var (gen-var id)))
+ (extend-ribcage! ribcage id label)
+ (parse (cdr body)
+ (cons id ids)
+ (cons label labels)
+ (cons id var-ids)
+ (cons var vars)
+ (cons (cons er (wrap e w mod)) vals)
+ (cons (cons 'lexical var) bindings)))))
+ ((memv key '(define-syntax-form
define-syntax-parameter-form))
+ (let ((id (wrap value w mod)) (label (gen-label)))
+ (extend-ribcage! ribcage id label)
+ (parse (cdr body)
+ (cons id ids)
+ (cons label labels)
+ var-ids
+ vars
+ vals
+ (cons (cons 'macro (cons er (wrap e w
mod))) bindings))))
+ ((memv key '(begin-form))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ .
each-any))))
+ (if tmp
+ (apply (lambda (e1)
+ (parse (let f ((forms e1))
+ (if (null? forms)
+ (cdr body)
+ (cons (cons er (wrap (car
forms) w mod)) (f (cdr forms)))))
+ ids
+ labels
+ var-ids
+ vars
+ vals
+ bindings))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1))))
+ ((memv key '(local-syntax-form))
+ (expand-local-syntax
+ value
+ e
+ er
+ w
+ s
+ mod
+ (lambda (forms er w s mod)
+ (parse (let f ((forms forms))
+ (if (null? forms)
+ (cdr body)
+ (cons (cons er (wrap (car forms) w
mod)) (f (cdr forms)))))
+ ids
+ labels
+ var-ids
+ vars
+ vals
+ bindings))))
+ ((null? ids)
+ (build-sequence
#f
- "source expression failed to match any pattern"
- body-24481))))))))))
- (let ((tmp-23465 ($sc-dispatch clauses-23459 '())))
- (if tmp-23465
- (@apply (lambda () (values '() #f)) tmp-23465)
- (let ((tmp-23469
- ($sc-dispatch
- clauses-23459
- '((any any . each-any)
- .
- #(each (any any . each-any))))))
- (if tmp-23469
- (@apply
- (lambda (args-23473
- e1-23474
- e2-23475
- args*-23476
- e1*-23477
- e2*-23478)
- (call-with-values
- (lambda () (get-formals-23458 args-23473))
- (lambda (req-23479 opt-23480 rest-23481 kw-23482)
- (call-with-values
- (lambda ()
- (parse-req-23460
- req-23479
- opt-23480
- rest-23481
- kw-23482
- (cons e1-23474 e2-23475)))
- (lambda (meta-23547
- req-23548
- opt-23549
- rest-23550
- kw-23551
- inits-23552
- vars-23553
- body-23554)
- (call-with-values
- (lambda ()
- (expand-lambda-case-4309
- e-23453
- r-23454
- w-23455
- s-23456
- mod-23457
- get-formals-23458
- (map (lambda (tmp-2800-23555
- tmp-2799-23556
- tmp-2798-23557)
- (cons tmp-2798-23557
- (cons tmp-2799-23556
- tmp-2800-23555)))
- e2*-23478
- e1*-23477
- args*-23476)))
- (lambda (meta*-23558 else*-23559)
- (values
- (append meta-23547 meta*-23558)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- s-23456
- req-23548
- opt-23549
- rest-23550
- kw-23551
- inits-23552
- vars-23553
- body-23554
- else*-23559)))))))))
- tmp-23469)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- clauses-23459))))))))
- (strip-4310
- (lambda (x-24548 w-24549)
- (if (memq 'top (car w-24549))
- x-24548
- (letrec*
- ((f-24550
- (lambda (x-24553)
- (if (if (vector? x-24553)
- (if (= (vector-length x-24553) 4)
- (eq? (vector-ref x-24553 0) 'syntax-object)
- #f)
- #f)
- (strip-4310
- (vector-ref x-24553 1)
- (vector-ref x-24553 2))
- (if (pair? x-24553)
- (let ((a-24572 (f-24550 (car x-24553)))
- (d-24573 (f-24550 (cdr x-24553))))
- (if (if (eq? a-24572 (car x-24553))
- (eq? d-24573 (cdr x-24553))
- #f)
- x-24553
- (cons a-24572 d-24573)))
- (if (vector? x-24553)
- (let ((old-24576 (vector->list x-24553)))
- (let ((new-24577 (map f-24550 old-24576)))
- (letrec*
- ((lp-24578
- (lambda (l1-24654 l2-24655)
- (if (null? l1-24654)
- x-24553
- (if (eq? (car l1-24654) (car l2-24655))
- (lp-24578 (cdr l1-24654) (cdr l2-24655))
- (list->vector new-24577))))))
- (lp-24578 old-24576 new-24577))))
- x-24553))))))
- (f-24550 x-24548)))))
- (gen-var-4311
- (lambda (id-23603)
- (let ((id-23604
- (if (if (vector? id-23603)
- (if (= (vector-length id-23603) 4)
- (eq? (vector-ref id-23603 0) 'syntax-object)
- #f)
- #f)
- (vector-ref id-23603 1)
- id-23603)))
- (gensym
- (string-append (symbol->string id-23604) "-"))))))
- (begin
- (set! session-id-4222
- (let ((v-14702
- (module-variable
- (current-module)
- 'syntax-session-id)))
- (lambda () ((variable-ref v-14702)))))
- (set! transformer-environment-4283
- (make-fluid
- (lambda (k-13734)
- (error "called outside the dynamic extent of a syntax
transformer"))))
- (module-define!
- (current-module)
- 'letrec-syntax
- (make-syntax-transformer
- 'letrec-syntax
- 'local-syntax
- #t))
- (module-define!
- (current-module)
- 'let-syntax
- (make-syntax-transformer
- 'let-syntax
- 'local-syntax
- #f))
- (global-extend-4259
- 'core
- 'syntax-parameterize
- (lambda (e-4430 r-4431 w-4432 s-4433 mod-4434)
- (let ((tmp-4436
- ($sc-dispatch
- e-4430
- '(_ #(each (any any)) any . each-any))))
- (if (if tmp-4436
- (@apply
- (lambda (var-4438 val-4439 e1-4440 e2-4441)
- (valid-bound-ids?-4287 var-4438))
- tmp-4436)
- #f)
- (@apply
- (lambda (var-4519 val-4520 e1-4521 e2-4522)
- (let ((names-4523
- (map (lambda (x-4573)
- (id-var-name-4280 x-4573 w-4432))
- var-4519)))
- (begin
- (for-each
- (lambda (id-4524 n-4525)
- (let ((key-4526
- (car (let ((t-4533 (assq n-4525 r-4431)))
- (if t-4533
- (cdr t-4533)
- (if (symbol? n-4525)
- (let ((t-4538
-
(get-global-definition-hook-4224
- n-4525
- mod-4434)))
- (if t-4538 t-4538 '(global)))
- '(displaced-lexical)))))))
- (if (eqv? key-4526 'displaced-lexical)
+ (map (lambda (x) (expand (cdr x) (car x) '(())
mod))
+ (cons (cons er (source-wrap e w s mod))
(cdr body)))))
+ (else
+ (if (not (valid-bound-ids? ids))
(syntax-violation
- 'syntax-parameterize
- "identifier out of context"
- e-4430
- (wrap-4290
- (begin
- (if (if s-4433
- (supports-source-properties? id-4524)
- #f)
- (set-source-properties! id-4524 s-4433))
- id-4524)
- w-4432
- mod-4434)))))
- var-4519
- names-4523)
- (expand-body-4301
- (cons e1-4521 e2-4522)
- (wrap-4290
- (begin
- (if (if s-4433
- (supports-source-properties? e-4430)
- #f)
- (set-source-properties! e-4430 s-4433))
- e-4430)
- w-4432
- mod-4434)
- (extend-env-4255
- names-4523
- (let ((trans-r-4659 (macros-only-env-4257 r-4431)))
- (map (lambda (x-4660)
- (cons 'macro
- (eval-local-transformer-4303
- (call-with-values
- (lambda ()
- (syntax-type-4296
- x-4660
- trans-r-4659
- w-4432
- (let ((props-4717
- (source-properties
- (if (if (vector?
- x-4660)
- (if (=
(vector-length
-
x-4660)
- 4)
- (eq?
(vector-ref
-
x-4660
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- x-4660
- 1)
- x-4660))))
- (if (pair? props-4717)
- props-4717
- #f))
- #f
- mod-4434
- #f))
- (lambda (type-4750
- value-4751
- form-4752
- e-4753
- w-4754
- s-4755
- mod-4756)
- (expand-expr-4298
- type-4750
- value-4751
- form-4752
- e-4753
- trans-r-4659
- w-4754
- s-4755
- mod-4756)))
- mod-4434)))
- val-4520))
- r-4431)
- w-4432
- mod-4434))))
- tmp-4436)
- (syntax-violation
- 'syntax-parameterize
- "bad syntax"
- (wrap-4290
- (begin
- (if (if s-4433
- (supports-source-properties? e-4430)
- #f)
- (set-source-properties! e-4430 s-4433))
- e-4430)
- w-4432
- mod-4434))))))
- (module-define!
- (current-module)
- 'quote
- (make-syntax-transformer
- 'quote
- 'core
- (lambda (e-4855 r-4856 w-4857 s-4858 mod-4859)
- (let ((tmp-4861 ($sc-dispatch e-4855 '(_ any))))
- (if tmp-4861
- (@apply
- (lambda (e-4862)
- (let ((exp-4866 (strip-4310 e-4862 w-4857)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- s-4858
- exp-4866)))
- tmp-4861)
- (syntax-violation
- 'quote
- "bad syntax"
- (wrap-4290
- (begin
- (if (if s-4858
- (supports-source-properties? e-4855)
- #f)
- (set-source-properties! e-4855 s-4858))
- e-4855)
- w-4857
- mod-4859)))))))
- (global-extend-4259
- 'core
- 'syntax
- (letrec*
- ((gen-syntax-5078
- (lambda (src-5175
- e-5176
- r-5177
- maps-5178
- ellipsis?-5179
- mod-5180)
- (if (if (symbol? e-5176)
- #t
- (if (if (vector? e-5176)
- (if (= (vector-length e-5176) 4)
- (eq? (vector-ref e-5176 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref e-5176 1))
- #f))
- (let ((label-5207 (id-var-name-4280 e-5176 '(()))))
- (let ((b-5208
- (let ((t-5215 (assq label-5207 r-5177)))
- (if t-5215
- (cdr t-5215)
- (if (symbol? label-5207)
- (let ((t-5221
- (get-global-definition-hook-4224
- label-5207
- mod-5180)))
- (if t-5221 t-5221 '(global)))
- '(displaced-lexical))))))
- (if (eq? (car b-5208) 'syntax)
- (call-with-values
- (lambda ()
- (let ((var.lev-5230 (cdr b-5208)))
- (gen-ref-5079
- src-5175
- (car var.lev-5230)
- (cdr var.lev-5230)
- maps-5178)))
- (lambda (var-5234 maps-5235)
- (values (list 'ref var-5234) maps-5235)))
- (if (ellipsis?-5179 e-5176)
+ #f
+ "invalid or duplicate identifier in definition"
+ outer-form))
+ (let loop ((bs bindings) (er-cache #f) (r-cache
#f))
+ (if (not (null? bs))
+ (let ((b (car bs)))
+ (if (eq? (car b) 'macro)
+ (let* ((er (cadr b))
+ (r-cache (if (eq? er er-cache)
r-cache (macros-only-env er))))
+ (set-cdr!
+ b
+ (eval-local-transformer (expand (cddr
b) r-cache '(()) mod) mod))
+ (loop (cdr bs) er r-cache))
+ (loop (cdr bs) er-cache r-cache)))))
+ (set-cdr! r (extend-env labels bindings (cdr r)))
+ (build-letrec
+ #f
+ #t
+ (reverse (map syntax->datum var-ids))
+ (reverse vars)
+ (map (lambda (x) (expand (cdr x) (car x) '(())
mod)) (reverse vals))
+ (build-sequence
+ #f
+ (map (lambda (x) (expand (cdr x) (car x) '(())
mod))
+ (cons (cons er (source-wrap e w s mod))
(cdr body))))))))))))))))
+ (expand-local-syntax
+ (lambda (rec? e r w s mod k)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any))))
+ (if tmp
+ (apply (lambda (id val e1 e2)
+ (let ((ids id))
+ (if (not (valid-bound-ids? ids))
+ (syntax-violation #f "duplicate bound keyword" e)
+ (let* ((labels (gen-labels ids)) (new-w
(make-binding-wrap ids labels w)))
+ (k (cons e1 e2)
+ (extend-env
+ labels
+ (let ((w (if rec? new-w w)) (trans-r
(macros-only-env r)))
+ (map (lambda (x)
+ (cons 'macro (eval-local-transformer
(expand x trans-r w mod) mod)))
+ val))
+ r)
+ new-w
+ s
+ mod)))))
+ tmp)
+ (syntax-violation
+ #f
+ "bad local syntax definition"
+ (source-wrap e w s mod))))))
+ (eval-local-transformer
+ (lambda (expanded mod)
+ (let ((p (local-eval-hook expanded mod)))
+ (if (procedure? p)
+ p
+ (syntax-violation #f "nonprocedure transformer" p)))))
+ (expand-void (lambda () (build-void #f)))
+ (ellipsis?
+ (lambda (x)
+ (and (nonsymbol-id? x)
+ (free-id=? x '#(syntax-object ... ((top)) (hygiene guile))))))
+ (lambda-formals
+ (lambda (orig-args)
+ (letrec*
+ ((req (lambda (args rreq)
+ (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (check (reverse rreq) #f)) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1))
+ (apply (lambda (a b) (req b (cons a rreq))) tmp-1)
+ (let ((tmp-1 (list tmp)))
+ (if (and tmp-1 (apply (lambda (r) (id? r)) tmp-1))
+ (apply (lambda (r) (check (reverse rreq) r))
tmp-1)
+ (let ((else tmp))
+ (syntax-violation 'lambda "invalid argument
list" orig-args args))))))))))
+ (check (lambda (req rest)
+ (if (distinct-bound-ids? (if rest (cons rest req) req))
+ (values req #f rest #f)
+ (syntax-violation
+ 'lambda
+ "duplicate identifier in argument list"
+ orig-args)))))
+ (req orig-args '()))))
+ (expand-simple-lambda
+ (lambda (e r w s mod req rest meta body)
+ (let* ((ids (if rest (append req (list rest)) req))
+ (vars (map gen-var ids))
+ (labels (gen-labels ids)))
+ (build-simple-lambda
+ s
+ (map syntax->datum req)
+ (and rest (syntax->datum rest))
+ vars
+ meta
+ (expand-body
+ body
+ (source-wrap e w s mod)
+ (extend-var-env labels vars r)
+ (make-binding-wrap ids labels w)
+ mod)))))
+ (lambda*-formals
+ (lambda (orig-args)
+ (letrec*
+ ((req (lambda (args rreq)
+ (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (check (reverse rreq) '() #f '()))
tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1))
+ (apply (lambda (a b) (req b (cons a rreq))) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1
+ (apply (lambda (a b) (eq? (syntax->datum
a) #:optional)) tmp-1))
+ (apply (lambda (a b) (opt b (reverse rreq) '()))
tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1
+ (apply (lambda (a b) (eq?
(syntax->datum a) #:key)) tmp-1))
+ (apply (lambda (a b) (key b (reverse rreq)
'() '())) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any any))))
+ (if (and tmp-1
+ (apply (lambda (a b) (eq?
(syntax->datum a) #:rest)) tmp-1))
+ (apply (lambda (a b) (rest b (reverse
rreq) '() '())) tmp-1)
+ (let ((tmp-1 (list tmp)))
+ (if (and tmp-1 (apply (lambda (r) (id?
r)) tmp-1))
+ (apply (lambda (r) (rest r (reverse
rreq) '() '())) tmp-1)
+ (let ((else tmp))
+ (syntax-violation
+ 'lambda*
+ "invalid argument list"
+ orig-args
+ args))))))))))))))))
+ (opt (lambda (args req ropt)
+ (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (check req (reverse ropt) #f '()))
tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1))
+ (apply (lambda (a b) (opt b req (cons (cons a '(#f))
ropt))) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '((any any) . any))))
+ (if (and tmp-1 (apply (lambda (a init b) (id? a))
tmp-1))
+ (apply (lambda (a init b) (opt b req (cons (list
a init) ropt)))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1
+ (apply (lambda (a b) (eq?
(syntax->datum a) #:key)) tmp-1))
+ (apply (lambda (a b) (key b req (reverse
ropt) '())) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any any))))
+ (if (and tmp-1
+ (apply (lambda (a b) (eq?
(syntax->datum a) #:rest)) tmp-1))
+ (apply (lambda (a b) (rest b req (reverse
ropt) '())) tmp-1)
+ (let ((tmp-1 (list tmp)))
+ (if (and tmp-1 (apply (lambda (r) (id?
r)) tmp-1))
+ (apply (lambda (r) (rest r req
(reverse ropt) '())) tmp-1)
+ (let ((else tmp))
+ (syntax-violation
+ 'lambda*
+ "invalid optional argument list"
+ orig-args
+ args))))))))))))))))
+ (key (lambda (args req opt rkey)
+ (let* ((tmp args) (tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (check req opt #f (cons #f (reverse
rkey)))) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if (and tmp-1 (apply (lambda (a b) (id? a)) tmp-1))
+ (apply (lambda (a b)
+ (let* ((tmp (symbol->keyword (syntax->datum
a))) (k tmp))
+ (key b req opt (cons (cons k (cons a
'(#f))) rkey))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '((any any) . any))))
+ (if (and tmp-1 (apply (lambda (a init b) (id? a))
tmp-1))
+ (apply (lambda (a init b)
+ (let* ((tmp (symbol->keyword
(syntax->datum a))) (k tmp))
+ (key b req opt (cons (list k a init)
rkey))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '((any any any) .
any))))
+ (if (and tmp-1
+ (apply (lambda (a init k b) (and (id?
a) (keyword? (syntax->datum k))))
+ tmp-1))
+ (apply (lambda (a init k b) (key b req opt
(cons (list k a init) rkey)))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any))))
+ (if (and tmp-1
+ (apply (lambda (aok) (eq?
(syntax->datum aok) #:allow-other-keys))
+ tmp-1))
+ (apply (lambda (aok) (check req opt #f
(cons #t (reverse rkey))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any any
any))))
+ (if (and tmp-1
+ (apply (lambda (aok a b)
+ (and (eq?
(syntax->datum aok) #:allow-other-keys)
+ (eq?
(syntax->datum a) #:rest)))
+ tmp-1))
+ (apply (lambda (aok a b) (rest b req
opt (cons #t (reverse rkey))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any
. any))))
+ (if (and tmp-1
+ (apply (lambda (aok r)
+ (and (eq?
(syntax->datum aok) #:allow-other-keys) (id? r)))
+ tmp-1))
+ (apply (lambda (aok r) (rest r
req opt (cons #t (reverse rkey))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp
'(any any))))
+ (if (and tmp-1
+ (apply (lambda (a b)
(eq? (syntax->datum a) #:rest)) tmp-1))
+ (apply (lambda (a b) (rest b
req opt (cons #f (reverse rkey))))
+ tmp-1)
+ (let ((tmp-1 (list tmp)))
+ (if (and tmp-1 (apply
(lambda (r) (id? r)) tmp-1))
+ (apply (lambda (r) (rest
r req opt (cons #f (reverse rkey))))
+ tmp-1)
+ (let ((else tmp))
+ (syntax-violation
+ 'lambda*
+ "invalid keyword
argument list"
+ orig-args
+
args))))))))))))))))))))))
+ (rest (lambda (args req opt kw)
+ (let* ((tmp-1 args) (tmp (list tmp-1)))
+ (if (and tmp (apply (lambda (r) (id? r)) tmp))
+ (apply (lambda (r) (check req opt r kw)) tmp)
+ (let ((else tmp-1))
+ (syntax-violation 'lambda* "invalid rest argument"
orig-args args))))))
+ (check (lambda (req opt rest kw)
+ (if (distinct-bound-ids?
+ (append
+ req
+ (map car opt)
+ (if rest (list rest) '())
+ (if (pair? kw) (map cadr (cdr kw)) '())))
+ (values req opt rest kw)
+ (syntax-violation
+ 'lambda*
+ "duplicate identifier in argument list"
+ orig-args)))))
+ (req orig-args '()))))
+ (expand-lambda-case
+ (lambda (e r w s mod get-formals clauses)
+ (letrec*
+ ((parse-req
+ (lambda (req opt rest kw body)
+ (let ((vars (map gen-var req)) (labels (gen-labels req)))
+ (let ((r* (extend-var-env labels vars r))
+ (w* (make-binding-wrap req labels w)))
+ (parse-opt
+ (map syntax->datum req)
+ opt
+ rest
+ kw
+ body
+ (reverse vars)
+ r*
+ w*
+ '()
+ '())))))
+ (parse-opt
+ (lambda (req opt rest kw body vars r* w* out inits)
+ (cond ((pair? opt)
+ (let* ((tmp-1 (car opt)) (tmp ($sc-dispatch tmp-1 '(any
any))))
+ (if tmp
+ (apply (lambda (id i)
+ (let* ((v (gen-var id))
+ (l (gen-labels (list v)))
+ (r** (extend-var-env l (list v) r*))
+ (w** (make-binding-wrap (list id) l
w*)))
+ (parse-opt
+ req
+ (cdr opt)
+ rest
+ kw
+ body
+ (cons v vars)
+ r**
+ w**
+ (cons (syntax->datum id) out)
+ (cons (expand i r* w* mod) inits))))
+ tmp)
(syntax-violation
- 'syntax
- "misplaced ellipsis"
- src-5175)
- (values (list 'quote e-5176) maps-5178)))))
- (let ((tmp-5237 ($sc-dispatch e-5176 '(any any))))
- (if (if tmp-5237
- (@apply
- (lambda (dots-5241 e-5242)
- (ellipsis?-5179 dots-5241))
- tmp-5237)
- #f)
- (@apply
- (lambda (dots-5243 e-5244)
- (gen-syntax-5078
- src-5175
- e-5244
- r-5177
- maps-5178
- (lambda (x-5245) #f)
- mod-5180))
- tmp-5237)
- (let ((tmp-5246 ($sc-dispatch e-5176 '(any any . any))))
- (if (if tmp-5246
- (@apply
- (lambda (x-5250 dots-5251 y-5252)
- (ellipsis?-5179 dots-5251))
- tmp-5246)
- #f)
- (@apply
- (lambda (x-5253 dots-5254 y-5255)
- (letrec*
- ((f-5256
- (lambda (y-5264 k-5265)
- (let ((tmp-5267
- ($sc-dispatch
- y-5264
- '(any . any))))
- (if (if tmp-5267
- (@apply
- (lambda (dots-5269 y-5270)
- (ellipsis?-5179 dots-5269))
- tmp-5267)
- #f)
- (@apply
- (lambda (dots-5271 y-5272)
- (f-5256
- y-5272
- (lambda (maps-5273)
- (call-with-values
- (lambda ()
- (k-5265
- (cons '() maps-5273)))
- (lambda (x-5274 maps-5275)
- (if (null? (car maps-5275))
- (syntax-violation
- 'syntax
- "extra ellipsis"
- src-5175)
- (values
- (let ((map-env-5279
- (car
maps-5275)))
- (list 'apply
- '(primitive
- append)
- (gen-map-5081
- x-5274
-
map-env-5279)))
- (cdr maps-5275))))))))
- tmp-5267)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- src-5175
- y-5264
- r-5177
- maps-5178
- ellipsis?-5179
- mod-5180))
- (lambda (y-5281 maps-5282)
- (call-with-values
- (lambda () (k-5265 maps-5282))
- (lambda (x-5283 maps-5284)
- (values
- (if (equal? y-5281 ''())
- x-5283
- (list 'append
- x-5283
- y-5281))
- maps-5284))))))))))
- (f-5256
- y-5255
- (lambda (maps-5259)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- src-5175
- x-5253
- r-5177
- (cons '() maps-5259)
- ellipsis?-5179
- mod-5180))
- (lambda (x-5260 maps-5261)
- (if (null? (car maps-5261))
- (syntax-violation
- 'syntax
- "extra ellipsis"
- src-5175)
- (values
- (gen-map-5081
- x-5260
- (car maps-5261))
- (cdr maps-5261)))))))))
- tmp-5246)
- (let ((tmp-5298 ($sc-dispatch e-5176 '(any . any))))
- (if tmp-5298
- (@apply
- (lambda (x-5302 y-5303)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- src-5175
- x-5302
- r-5177
- maps-5178
- ellipsis?-5179
- mod-5180))
- (lambda (x-5304 maps-5305)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- src-5175
- y-5303
- r-5177
- maps-5305
- ellipsis?-5179
- mod-5180))
- (lambda (y-5306 maps-5307)
- (values
- (let ((key-5312 (car y-5306)))
- (if (eqv? key-5312 'quote)
- (if (eq? (car x-5304) 'quote)
- (list 'quote
- (cons (car (cdr x-5304))
- (car (cdr
y-5306))))
- (if (eq? (car (cdr y-5306))
- '())
- (list 'list x-5304)
- (list 'cons x-5304 y-5306)))
- (if (eqv? key-5312 'list)
- (cons 'list
- (cons x-5304
- (cdr y-5306)))
- (list 'cons x-5304 y-5306))))
- maps-5307))))))
- tmp-5298)
- (let ((tmp-5341
- ($sc-dispatch
- e-5176
- '#(vector (any . each-any)))))
- (if tmp-5341
- (@apply
- (lambda (e1-5345 e2-5346)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- src-5175
- (cons e1-5345 e2-5346)
- r-5177
- maps-5178
- ellipsis?-5179
- mod-5180))
- (lambda (e-5347 maps-5348)
- (values
- (if (eq? (car e-5347) 'list)
- (cons 'vector (cdr e-5347))
- (if (eq? (car e-5347) 'quote)
- (list 'quote
- (list->vector
- (car (cdr e-5347))))
- (list 'list->vector e-5347)))
- maps-5348))))
- tmp-5341)
- (values
- (list 'quote e-5176)
- maps-5178))))))))))))
- (gen-ref-5079
- (lambda (src-5374 var-5375 level-5376 maps-5377)
- (if (= level-5376 0)
- (values var-5375 maps-5377)
- (if (null? maps-5377)
- (syntax-violation
- 'syntax
- "missing ellipsis"
- src-5374)
- (call-with-values
- (lambda ()
- (gen-ref-5079
- src-5374
- var-5375
- (#{1-}# level-5376)
- (cdr maps-5377)))
- (lambda (outer-var-5378 outer-maps-5379)
- (let ((b-5380 (assq outer-var-5378 (car maps-5377))))
- (if b-5380
- (values (cdr b-5380) maps-5377)
- (let ((inner-var-5382
- (gensym
- (string-append
- (symbol->string 'tmp)
- "-"))))
- (values
- inner-var-5382
- (cons (cons (cons outer-var-5378 inner-var-5382)
- (car maps-5377))
- outer-maps-5379)))))))))))
- (gen-map-5081
- (lambda (e-5396 map-env-5397)
- (let ((formals-5398 (map cdr map-env-5397))
- (actuals-5399
- (map (lambda (x-5401) (list 'ref (car x-5401)))
- map-env-5397)))
- (if (eq? (car e-5396) 'ref)
- (car actuals-5399)
- (if (and-map
- (lambda (x-5402)
- (if (eq? (car x-5402) 'ref)
- (memq (car (cdr x-5402)) formals-5398)
- #f))
- (cdr e-5396))
- (cons 'map
- (cons (list 'primitive (car e-5396))
- (map (let ((r-5404
- (map cons
- formals-5398
- actuals-5399)))
- (lambda (x-5405)
- (cdr (assq (car (cdr x-5405))
- r-5404))))
- (cdr e-5396))))
- (cons 'map
- (cons (list 'lambda formals-5398 e-5396)
- actuals-5399)))))))
- (regen-5085
- (lambda (x-5407)
- (let ((key-5408 (car x-5407)))
- (if (eqv? key-5408 'ref)
- (let ((name-5418 (car (cdr x-5407)))
- (var-5419 (car (cdr x-5407))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- name-5418
- var-5419))
- (if (eqv? key-5408 'primitive)
- (let ((name-5431 (car (cdr x-5407))))
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
#f
- name-5431)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- name-5431
- #f)))
- (if (eqv? key-5408 'quote)
- (let ((exp-5449 (car (cdr x-5407))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- exp-5449))
- (if (eqv? key-5408 'lambda)
- (if (list? (car (cdr x-5407)))
- (let ((req-5460 (car (cdr x-5407)))
- (vars-5462 (car (cdr x-5407)))
- (exp-5464
- (regen-5085 (car (cdr (cdr x-5407))))))
- (let ((body-5469
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- req-5460
- #f
- #f
- #f
- '()
- vars-5462
- exp-5464
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- #f
- '()
- body-5469)))
- (error "how did we get here" x-5407))
- (let ((fun-exp-5485
- (let ((name-5494 (car x-5407)))
- (if (equal?
- (module-name (current-module))
- '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- name-5494)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- name-5494
- #f))))
- (arg-exps-5486 (map regen-5085 (cdr x-5407))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-5485
- arg-exps-5486))))))))))
- (lambda (e-5086 r-5087 w-5088 s-5089 mod-5090)
- (let ((e-5091
- (wrap-4290
- (begin
- (if (if s-5089
- (supports-source-properties? e-5086)
- #f)
- (set-source-properties! e-5086 s-5089))
- e-5086)
- w-5088
- mod-5090)))
- (let ((tmp-5093 ($sc-dispatch e-5091 '(_ any))))
- (if tmp-5093
- (@apply
- (lambda (x-5116)
- (call-with-values
- (lambda ()
- (gen-syntax-5078
- e-5091
- x-5116
- r-5087
- '()
- ellipsis?-4305
- mod-5090))
- (lambda (e-5170 maps-5171) (regen-5085 e-5170))))
- tmp-5093)
- (syntax-violation
- 'syntax
- "bad `syntax' form"
- e-5091)))))))
- (global-extend-4259
- 'core
- 'lambda
- (lambda (e-5679 r-5680 w-5681 s-5682 mod-5683)
- (let ((tmp-5685
- ($sc-dispatch e-5679 '(_ any any . each-any))))
- (if tmp-5685
- (@apply
- (lambda (args-5687 e1-5688 e2-5689)
- (call-with-values
- (lambda () (lambda-formals-4306 args-5687))
- (lambda (req-5692 opt-5693 rest-5694 kw-5695)
- (letrec*
- ((lp-5696
- (lambda (body-5699 meta-5700)
- (let ((tmp-5702
- ($sc-dispatch
- body-5699
- '(any any . each-any))))
- (if (if tmp-5702
- (@apply
- (lambda (docstring-5706 e1-5707 e2-5708)
- (string?
- (syntax->datum docstring-5706)))
- tmp-5702)
- #f)
- (@apply
- (lambda (docstring-5709 e1-5710 e2-5711)
- (lp-5696
- (cons e1-5710 e2-5711)
- (append
- meta-5700
- (list (cons 'documentation
- (syntax->datum
- docstring-5709))))))
- tmp-5702)
- (let ((tmp-5712
- ($sc-dispatch
- body-5699
- '(#(vector #(each (any . any)))
- any
- .
- each-any))))
- (if tmp-5712
- (@apply
- (lambda (k-5716 v-5717 e1-5718 e2-5719)
- (lp-5696
- (cons e1-5718 e2-5719)
- (append
- meta-5700
- (syntax->datum
- (map cons k-5716 v-5717)))))
- tmp-5712)
- (expand-simple-lambda-4307
- e-5679
- r-5680
- w-5681
- s-5682
- mod-5683
- req-5692
- rest-5694
- meta-5700
- body-5699))))))))
- (lp-5696 (cons e1-5688 e2-5689) '())))))
- tmp-5685)
- (syntax-violation 'lambda "bad lambda" e-5679)))))
- (global-extend-4259
- 'core
- 'lambda*
- (lambda (e-6002 r-6003 w-6004 s-6005 mod-6006)
- (let ((tmp-6008
- ($sc-dispatch e-6002 '(_ any any . each-any))))
- (if tmp-6008
- (@apply
- (lambda (args-6010 e1-6011 e2-6012)
- (call-with-values
- (lambda ()
- (expand-lambda-case-4309
- e-6002
- r-6003
- w-6004
- s-6005
- mod-6006
- lambda*-formals-4308
- (list (cons args-6010 (cons e1-6011 e2-6012)))))
- (lambda (meta-6015 lcase-6016)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-6005
- meta-6015
- lcase-6016))))
- tmp-6008)
- (syntax-violation 'lambda "bad lambda*" e-6002)))))
- (global-extend-4259
- 'core
- 'case-lambda
- (lambda (e-6181 r-6182 w-6183 s-6184 mod-6185)
- (let ((tmp-6187
- ($sc-dispatch
- e-6181
- '(_ (any any . each-any)
- .
- #(each (any any . each-any))))))
- (if tmp-6187
- (@apply
- (lambda (args-6189
- e1-6190
- e2-6191
- args*-6192
- e1*-6193
- e2*-6194)
- (call-with-values
- (lambda ()
- (expand-lambda-case-4309
- e-6181
- r-6182
- w-6183
- s-6184
- mod-6185
- lambda-formals-4306
- (cons (cons args-6189 (cons e1-6190 e2-6191))
- (map (lambda (tmp-3252-6197
- tmp-3251-6198
- tmp-3250-6199)
- (cons tmp-3250-6199
- (cons tmp-3251-6198 tmp-3252-6197)))
- e2*-6194
- e1*-6193
- args*-6192))))
- (lambda (meta-6200 lcase-6201)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-6184
- meta-6200
- lcase-6201))))
- tmp-6187)
- (syntax-violation
- 'case-lambda
- "bad case-lambda"
- e-6181)))))
- (global-extend-4259
- 'core
- 'case-lambda*
- (lambda (e-6358 r-6359 w-6360 s-6361 mod-6362)
- (let ((tmp-6364
- ($sc-dispatch
- e-6358
- '(_ (any any . each-any)
- .
- #(each (any any . each-any))))))
- (if tmp-6364
- (@apply
- (lambda (args-6366
- e1-6367
- e2-6368
- args*-6369
- e1*-6370
- e2*-6371)
- (call-with-values
- (lambda ()
- (expand-lambda-case-4309
- e-6358
- r-6359
- w-6360
- s-6361
- mod-6362
- lambda*-formals-4308
- (cons (cons args-6366 (cons e1-6367 e2-6368))
- (map (lambda (tmp-3285-6374
- tmp-3284-6375
- tmp-3283-6376)
- (cons tmp-3283-6376
- (cons tmp-3284-6375 tmp-3285-6374)))
- e2*-6371
- e1*-6370
- args*-6369))))
- (lambda (meta-6377 lcase-6378)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-6361
- meta-6377
- lcase-6378))))
- tmp-6364)
- (syntax-violation
- 'case-lambda
- "bad case-lambda*"
- e-6358)))))
- (global-extend-4259
- 'core
- 'let
- (letrec*
- ((expand-let-6566
- (lambda (e-6714
- r-6715
- w-6716
- s-6717
- mod-6718
- constructor-6719
- ids-6720
- vals-6721
- exps-6722)
- (if (not (valid-bound-ids?-4287 ids-6720))
- (syntax-violation
- 'let
- "duplicate bound variable"
- e-6714)
- (let ((labels-6800 (gen-labels-4264 ids-6720))
- (new-vars-6801 (map gen-var-4311 ids-6720)))
- (let ((nw-6802
- (make-binding-wrap-4275
- ids-6720
- labels-6800
- w-6716))
- (nr-6803
- (extend-var-env-4256
- labels-6800
- new-vars-6801
- r-6715)))
- (constructor-6719
- s-6717
- (map syntax->datum ids-6720)
- new-vars-6801
- (map (lambda (x-6820)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- x-6820
- r-6715
- w-6716
- (let ((props-6836
- (source-properties
- (if (if (vector? x-6820)
- (if (= (vector-length
- x-6820)
- 4)
- (eq? (vector-ref
- x-6820
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-6820 1)
- x-6820))))
- (if (pair? props-6836) props-6836 #f))
- #f
- mod-6718
- #f))
- (lambda (type-6869
- value-6870
- form-6871
- e-6872
- w-6873
- s-6874
- mod-6875)
- (expand-expr-4298
- type-6869
- value-6870
- form-6871
- e-6872
- r-6715
- w-6873
- s-6874
- mod-6875))))
- vals-6721)
- (expand-body-4301
- exps-6722
- (source-wrap-4291 e-6714 nw-6802 s-6717 mod-6718)
- nr-6803
- nw-6802
- mod-6718))))))))
- (lambda (e-6567 r-6568 w-6569 s-6570 mod-6571)
- (let ((tmp-6573
- ($sc-dispatch
- e-6567
- '(_ #(each (any any)) any . each-any))))
- (if (if tmp-6573
- (@apply
- (lambda (id-6577 val-6578 e1-6579 e2-6580)
- (and-map id?-4261 id-6577))
- tmp-6573)
- #f)
- (@apply
- (lambda (id-6596 val-6597 e1-6598 e2-6599)
- (expand-let-6566
- e-6567
- r-6568
- w-6569
- s-6570
- mod-6571
- build-let-4243
- id-6596
- val-6597
- (cons e1-6598 e2-6599)))
- tmp-6573)
- (let ((tmp-6629
- ($sc-dispatch
- e-6567
- '(_ any #(each (any any)) any . each-any))))
- (if (if tmp-6629
- (@apply
- (lambda (f-6633 id-6634 val-6635 e1-6636 e2-6637)
- (if (if (symbol? f-6633)
- #t
- (if (if (vector? f-6633)
- (if (= (vector-length f-6633) 4)
- (eq? (vector-ref f-6633 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref f-6633 1))
- #f))
- (and-map id?-4261 id-6634)
- #f))
- tmp-6629)
- #f)
- (@apply
- (lambda (f-6679 id-6680 val-6681 e1-6682 e2-6683)
- (expand-let-6566
- e-6567
- r-6568
- w-6569
- s-6570
- mod-6571
- build-named-let-4244
- (cons f-6679 id-6680)
- val-6681
- (cons e1-6682 e2-6683)))
- tmp-6629)
- (syntax-violation
- 'let
- "bad let"
- (wrap-4290
- (begin
- (if (if s-6570
- (supports-source-properties? e-6567)
- #f)
- (set-source-properties! e-6567 s-6570))
- e-6567)
- w-6569
- mod-6571)))))))))
- (global-extend-4259
- 'core
- 'letrec
- (lambda (e-7219 r-7220 w-7221 s-7222 mod-7223)
- (let ((tmp-7225
- ($sc-dispatch
- e-7219
- '(_ #(each (any any)) any . each-any))))
- (if (if tmp-7225
- (@apply
- (lambda (id-7227 val-7228 e1-7229 e2-7230)
- (and-map id?-4261 id-7227))
- tmp-7225)
- #f)
- (@apply
- (lambda (id-7246 val-7247 e1-7248 e2-7249)
- (if (not (valid-bound-ids?-4287 id-7246))
- (syntax-violation
- 'letrec
- "duplicate bound variable"
- e-7219)
- (let ((labels-7339 (gen-labels-4264 id-7246))
- (new-vars-7340 (map gen-var-4311 id-7246)))
- (let ((w-7341
- (make-binding-wrap-4275
- id-7246
- labels-7339
- w-7221))
- (r-7342
- (extend-var-env-4256
- labels-7339
- new-vars-7340
- r-7220)))
- (build-letrec-4245
- s-7222
- #f
- (map syntax->datum id-7246)
- new-vars-7340
- (map (lambda (x-7427)
- (expand-4297 x-7427 r-7342 w-7341 mod-7223))
- val-7247)
- (expand-body-4301
- (cons e1-7248 e2-7249)
- (wrap-4290
- (begin
- (if (if s-7222
- (supports-source-properties? e-7219)
- #f)
- (set-source-properties! e-7219 s-7222))
- e-7219)
- w-7341
- mod-7223)
- r-7342
- w-7341
- mod-7223))))))
- tmp-7225)
- (syntax-violation
- 'letrec
- "bad letrec"
- (wrap-4290
- (begin
- (if (if s-7222
- (supports-source-properties? e-7219)
- #f)
- (set-source-properties! e-7219 s-7222))
- e-7219)
- w-7221
- mod-7223))))))
- (global-extend-4259
- 'core
- 'letrec*
- (lambda (e-7817 r-7818 w-7819 s-7820 mod-7821)
- (let ((tmp-7823
- ($sc-dispatch
- e-7817
- '(_ #(each (any any)) any . each-any))))
- (if (if tmp-7823
- (@apply
- (lambda (id-7825 val-7826 e1-7827 e2-7828)
- (and-map id?-4261 id-7825))
- tmp-7823)
- #f)
- (@apply
- (lambda (id-7844 val-7845 e1-7846 e2-7847)
- (if (not (valid-bound-ids?-4287 id-7844))
+ "source expression failed to match any pattern"
+ tmp-1))))
+ (rest
+ (let* ((v (gen-var rest))
+ (l (gen-labels (list v)))
+ (r* (extend-var-env l (list v) r*))
+ (w* (make-binding-wrap (list rest) l w*)))
+ (parse-kw
+ req
+ (and (pair? out) (reverse out))
+ (syntax->datum rest)
+ (if (pair? kw) (cdr kw) kw)
+ body
+ (cons v vars)
+ r*
+ w*
+ (and (pair? kw) (car kw))
+ '()
+ inits)))
+ (else
+ (parse-kw
+ req
+ (and (pair? out) (reverse out))
+ #f
+ (if (pair? kw) (cdr kw) kw)
+ body
+ vars
+ r*
+ w*
+ (and (pair? kw) (car kw))
+ '()
+ inits)))))
+ (parse-kw
+ (lambda (req opt rest kw body vars r* w* aok out inits)
+ (if (pair? kw)
+ (let* ((tmp-1 (car kw)) (tmp ($sc-dispatch tmp-1 '(any any
any))))
+ (if tmp
+ (apply (lambda (k id i)
+ (let* ((v (gen-var id))
+ (l (gen-labels (list v)))
+ (r** (extend-var-env l (list v) r*))
+ (w** (make-binding-wrap (list id) l w*)))
+ (parse-kw
+ req
+ opt
+ rest
+ (cdr kw)
+ body
+ (cons v vars)
+ r**
+ w**
+ aok
+ (cons (list (syntax->datum k) (syntax->datum
id) v) out)
+ (cons (expand i r* w* mod) inits))))
+ tmp)
(syntax-violation
- 'letrec*
- "duplicate bound variable"
- e-7817)
- (let ((labels-7937 (gen-labels-4264 id-7844))
- (new-vars-7938 (map gen-var-4311 id-7844)))
- (let ((w-7939
- (make-binding-wrap-4275
- id-7844
- labels-7937
- w-7819))
- (r-7940
- (extend-var-env-4256
- labels-7937
- new-vars-7938
- r-7818)))
- (build-letrec-4245
- s-7820
- #t
- (map syntax->datum id-7844)
- new-vars-7938
- (map (lambda (x-8025)
- (expand-4297 x-8025 r-7940 w-7939 mod-7821))
- val-7845)
- (expand-body-4301
- (cons e1-7846 e2-7847)
- (wrap-4290
- (begin
- (if (if s-7820
- (supports-source-properties? e-7817)
- #f)
- (set-source-properties! e-7817 s-7820))
- e-7817)
- w-7939
- mod-7821)
- r-7940
- w-7939
- mod-7821))))))
- tmp-7823)
- (syntax-violation
- 'letrec*
- "bad letrec*"
- (wrap-4290
- (begin
- (if (if s-7820
- (supports-source-properties? e-7817)
- #f)
- (set-source-properties! e-7817 s-7820))
- e-7817)
- w-7819
- mod-7821))))))
- (global-extend-4259
- 'core
- 'set!
- (lambda (e-8488 r-8489 w-8490 s-8491 mod-8492)
- (let ((tmp-8494 ($sc-dispatch e-8488 '(_ any any))))
- (if (if tmp-8494
- (@apply
- (lambda (id-8498 val-8499)
- (if (symbol? id-8498)
- #t
- (if (if (vector? id-8498)
- (if (= (vector-length id-8498) 4)
- (eq? (vector-ref id-8498 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref id-8498 1))
- #f)))
- tmp-8494)
- #f)
- (@apply
- (lambda (id-8526 val-8527)
- (let ((n-8528 (id-var-name-4280 id-8526 w-8490))
- (id-mod-8529
- (if (if (vector? id-8526)
- (if (= (vector-length id-8526) 4)
- (eq? (vector-ref id-8526 0) 'syntax-object)
- #f)
- #f)
- (vector-ref id-8526 3)
- mod-8492)))
- (let ((b-8530
- (let ((t-8571 (assq n-8528 r-8489)))
- (if t-8571
- (cdr t-8571)
- (if (symbol? n-8528)
- (let ((t-8576
- (get-global-definition-hook-4224
- n-8528
- id-mod-8529)))
- (if t-8576 t-8576 '(global)))
- '(displaced-lexical))))))
- (let ((key-8531 (car b-8530)))
- (if (eqv? key-8531 'lexical)
- (let ((name-8588 (syntax->datum id-8526))
- (var-8589 (cdr b-8530))
- (exp-8590
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))
+ (parse-body
+ req
+ opt
+ rest
+ (and (or aok (pair? out)) (cons aok (reverse out)))
+ body
+ (reverse vars)
+ r*
+ w*
+ (reverse inits)
+ '()))))
+ (parse-body
+ (lambda (req opt rest kw body vars r* w* inits meta)
+ (let* ((tmp body) (tmp-1 ($sc-dispatch tmp '(any any .
each-any))))
+ (if (and tmp-1
+ (apply (lambda (docstring e1 e2) (string?
(syntax->datum docstring)))
+ tmp-1))
+ (apply (lambda (docstring e1 e2)
+ (parse-body
+ req
+ opt
+ rest
+ kw
+ (cons e1 e2)
+ vars
+ r*
+ w*
+ inits
+ (append meta (list (cons 'documentation
(syntax->datum docstring))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(vector #(each (any .
any))) any . each-any))))
+ (if tmp-1
+ (apply (lambda (k v e1 e2)
+ (parse-body
+ req
+ opt
+ rest
+ kw
+ (cons e1 e2)
+ vars
+ r*
+ w*
+ inits
+ (append meta (syntax->datum (map cons k v)))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . each-any))))
+ (if tmp-1
+ (apply (lambda (e1 e2)
+ (values
+ meta
+ req
+ opt
+ rest
+ kw
+ inits
+ vars
+ (expand-body (cons e1 e2) (source-wrap e
w s mod) r* w* mod)))
+ tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp))))))))))
+ (let* ((tmp clauses) (tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (values '() #f)) tmp-1)
+ (let ((tmp-1 ($sc-dispatch
+ tmp
+ '((any any . each-any) . #(each (any any .
each-any))))))
+ (if tmp-1
+ (apply (lambda (args e1 e2 args* e1* e2*)
+ (call-with-values
+ (lambda () (get-formals args))
+ (lambda (req opt rest kw)
+ (call-with-values
+ (lambda () (parse-req req opt rest kw (cons e1
e2)))
+ (lambda (meta req opt rest kw inits vars body)
(call-with-values
(lambda ()
- (syntax-type-4296
- val-8527
- r-8489
- w-8490
- (let ((props-8611
- (source-properties
- (if (if (vector? val-8527)
- (if (= (vector-length
- val-8527)
- 4)
- (eq? (vector-ref
- val-8527
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref val-8527 1)
- val-8527))))
- (if (pair? props-8611)
- props-8611
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-8644
- value-8645
- form-8646
- e-8647
- w-8648
- s-8649
- mod-8650)
- (expand-expr-4298
- type-8644
- value-8645
- form-8646
- e-8647
- r-8489
- w-8648
- s-8649
- mod-8650)))))
- (begin
- (if (if (struct? exp-8590)
- (eq? (struct-vtable exp-8590)
- (vector-ref %expanded-vtables 13))
- #f)
- (let ((meta-8662 (struct-ref exp-8590 1)))
- (if (not (assq 'name meta-8662))
- (let ((v-8669
- (cons (cons 'name name-8588)
- meta-8662)))
- (struct-set! exp-8590 1 v-8669)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 4)
- s-8491
- name-8588
- var-8589
- exp-8590)))
- (if (eqv? key-8531 'global)
- (let ((exp-8685
- (call-with-values
- (lambda ()
- (syntax-type-4296
- val-8527
- r-8489
- w-8490
- (let ((props-8707
- (source-properties
- (if (if (vector? val-8527)
- (if (= (vector-length
- val-8527)
- 4)
- (eq? (vector-ref
- val-8527
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref val-8527 1)
- val-8527))))
- (if (pair? props-8707)
- props-8707
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-8740
- value-8741
- form-8742
- e-8743
- w-8744
- s-8745
- mod-8746)
- (expand-expr-4298
- type-8740
- value-8741
- form-8742
- e-8743
- r-8489
- w-8744
- s-8745
- mod-8746)))))
- (begin
- (if (if (struct? exp-8685)
- (eq? (struct-vtable exp-8685)
- (vector-ref %expanded-vtables 13))
- #f)
- (let ((meta-8758 (struct-ref exp-8685 1)))
- (if (not (assq 'name meta-8758))
- (let ((v-8765
- (cons (cons 'name n-8528)
- meta-8758)))
- (struct-set! exp-8685 1 v-8765)))))
- (analyze-variable-4233
- id-mod-8529
- n-8528
- (lambda (mod-8773 var-8774 public?-8775)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 6)
- s-8491
- mod-8773
- var-8774
- public?-8775
- exp-8685))
- (lambda (var-8784)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 8)
- s-8491
- var-8784
- exp-8685)))))
- (if (eqv? key-8531 'macro)
- (let ((p-8794 (cdr b-8530)))
- (if (procedure-property
- p-8794
- 'variable-transformer)
- (let ((e-8799
- (expand-macro-4300
- p-8794
- e-8488
- r-8489
- w-8490
- s-8491
- #f
- mod-8492)))
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-8799
- r-8489
- '(())
- (let ((props-8810
- (source-properties
- (if (if (vector? e-8799)
- (if (= (vector-length
- e-8799)
- 4)
- (eq? (vector-ref
- e-8799
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref e-8799 1)
- e-8799))))
- (if (pair? props-8810)
- props-8810
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-8833
- value-8834
- form-8835
- e-8836
- w-8837
- s-8838
- mod-8839)
- (expand-expr-4298
- type-8833
- value-8834
- form-8835
- e-8836
- r-8489
- w-8837
- s-8838
- mod-8839))))
- (syntax-violation
- 'set!
- "not a variable transformer"
- (wrap-4290 e-8488 w-8490 mod-8492)
- (wrap-4290 id-8526 w-8490 id-mod-8529))))
- (if (eqv? key-8531 'displaced-lexical)
- (syntax-violation
- 'set!
- "identifier out of context"
- (wrap-4290 id-8526 w-8490 mod-8492))
- (syntax-violation
- 'set!
- "bad set!"
- (wrap-4290
- (begin
- (if (if s-8491
- (supports-source-properties?
- e-8488)
- #f)
- (set-source-properties! e-8488 s-8491))
- e-8488)
- w-8490
- mod-8492))))))))))
- tmp-8494)
- (let ((tmp-8874
- ($sc-dispatch e-8488 '(_ (any . each-any) any))))
- (if tmp-8874
- (@apply
- (lambda (head-8878 tail-8879 val-8880)
+ (expand-lambda-case
+ e
+ r
+ w
+ s
+ mod
+ get-formals
+ (map (lambda (tmp-2 tmp-1 tmp) (cons
tmp (cons tmp-1 tmp-2)))
+ e2*
+ e1*
+ args*)))
+ (lambda (meta* else*)
+ (values
+ (append meta meta*)
+ (build-lambda-case s req opt rest kw
inits vars body else*)))))))))
+ tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp))))))))
+ (strip (lambda (x w)
+ (if (memq 'top (car w))
+ x
+ (let f ((x x))
+ (cond ((syntax-object? x)
+ (strip (syntax-object-expression x) (syntax-object-wrap
x)))
+ ((pair? x)
+ (let ((a (f (car x))) (d (f (cdr x))))
+ (if (and (eq? a (car x)) (eq? d (cdr x))) x (cons a
d))))
+ ((vector? x)
+ (let* ((old (vector->list x)) (new (map f old)))
+ (let lp ((l1 old) (l2 new))
+ (cond ((null? l1) x)
+ ((eq? (car l1) (car l2)) (lp (cdr l1) (cdr
l2)))
+ (else (list->vector new))))))
+ (else x))))))
+ (gen-var
+ (lambda (id)
+ (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+ (gensym (string-append (symbol->string id) "-")))))
+ (lambda-var-list
+ (lambda (vars)
+ (let lvl ((vars vars) (ls '()) (w '(())))
+ (cond ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls)
w))
+ ((id? vars) (cons (wrap vars w #f) ls))
+ ((null? vars) ls)
+ ((syntax-object? vars)
+ (lvl (syntax-object-expression vars)
+ ls
+ (join-wraps w (syntax-object-wrap vars))))
+ (else (cons vars ls)))))))
+ (global-extend 'local-syntax 'letrec-syntax #t)
+ (global-extend 'local-syntax 'let-syntax #f)
+ (global-extend
+ 'core
+ 'syntax-parameterize
+ (lambda (e r w s mod)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any))))
+ (if (and tmp (apply (lambda (var val e1 e2) (valid-bound-ids? var))
tmp))
+ (apply (lambda (var val e1 e2)
+ (let ((names (map (lambda (x) (id-var-name x w)) var)))
+ (for-each
+ (lambda (id n)
+ (let ((key (car (lookup n r mod))))
+ (if (memv key '(displaced-lexical))
+ (syntax-violation
+ 'syntax-parameterize
+ "identifier out of context"
+ e
+ (source-wrap id w s mod)))))
+ var
+ names)
+ (expand-body
+ (cons e1 e2)
+ (source-wrap e w s mod)
+ (extend-env
+ names
+ (let ((trans-r (macros-only-env r)))
+ (map (lambda (x)
+ (cons 'macro (eval-local-transformer (expand
x trans-r w mod) mod)))
+ val))
+ r)
+ w
+ mod)))
+ tmp)
+ (syntax-violation
+ 'syntax-parameterize
+ "bad syntax"
+ (source-wrap e w s mod))))))
+ (global-extend
+ 'core
+ 'quote
+ (lambda (e r w s mod)
+ (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any))))
+ (if tmp
+ (apply (lambda (e) (build-data s (strip e w))) tmp)
+ (syntax-violation 'quote "bad syntax" (source-wrap e w s mod))))))
+ (global-extend
+ 'core
+ 'syntax
+ (letrec*
+ ((gen-syntax
+ (lambda (src e r maps ellipsis? mod)
+ (if (id? e)
+ (let* ((label (id-var-name e '(()))) (b (lookup label r mod)))
+ (cond ((eq? (car b) 'syntax)
(call-with-values
(lambda ()
- (syntax-type-4296
- head-8878
- r-8489
- '(())
- #f
- #f
- mod-8492
- #t))
- (lambda (type-8883
- value-8884
- formform-8885
- ee-8886
- ww-8887
- ss-8888
- modmod-8889)
- (if (eqv? type-8883 'module-ref)
- (let ((val-8895
+ (let ((var.lev (cdr b)))
+ (gen-ref src (car var.lev) (cdr var.lev) maps)))
+ (lambda (var maps) (values (list 'ref var) maps))))
+ ((ellipsis? e) (syntax-violation 'syntax "misplaced
ellipsis" src))
+ (else (values (list 'quote e) maps))))
+ (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(any any))))
+ (if (and tmp-1 (apply (lambda (dots e) (ellipsis? dots)) tmp-1))
+ (apply (lambda (dots e) (gen-syntax src e r maps (lambda (x)
#f) mod))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any any . any))))
+ (if (and tmp-1 (apply (lambda (x dots y) (ellipsis? dots))
tmp-1))
+ (apply (lambda (x dots y)
+ (let f ((y y)
+ (k (lambda (maps)
+ (call-with-values
+ (lambda () (gen-syntax src x r
(cons '() maps) ellipsis? mod))
+ (lambda (x maps)
+ (if (null? (car maps))
+ (syntax-violation 'syntax
"extra ellipsis" src)
+ (values (gen-map x (car
maps)) (cdr maps))))))))
+ (let* ((tmp y) (tmp ($sc-dispatch tmp '(any .
any))))
+ (if (and tmp (apply (lambda (dots y)
(ellipsis? dots)) tmp))
+ (apply (lambda (dots y)
+ (f y
+ (lambda (maps)
+ (call-with-values
+ (lambda () (k (cons '()
maps)))
+ (lambda (x maps)
+ (if (null? (car maps))
+ (syntax-violation
'syntax "extra ellipsis" src)
+ (values (gen-mappend x
(car maps)) (cdr maps))))))))
+ tmp)
(call-with-values
- (lambda ()
- (syntax-type-4296
- val-8880
- r-8489
- w-8490
- (let ((props-8962
- (source-properties
- (if (if (vector? val-8880)
- (if (= (vector-length
- val-8880)
- 4)
- (eq? (vector-ref
- val-8880
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref val-8880 1)
- val-8880))))
- (if (pair? props-8962)
- props-8962
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-8995
- value-8996
- form-8997
- e-8998
- w-8999
- s-9000
- mod-9001)
- (expand-expr-4298
- type-8995
- value-8996
- form-8997
- e-8998
- r-8489
- w-8999
- s-9000
- mod-9001)))))
- (call-with-values
- (lambda ()
- (value-8884
- (cons head-8878 tail-8879)
- r-8489
- w-8490))
- (lambda (e-8896 r-8897 w-8898 s*-8899 mod-8900)
- (let ((tmp-8902 (list e-8896)))
- (if (@apply
- (lambda (e-8904)
- (if (symbol? e-8904)
- #t
- (if (if (vector? e-8904)
- (if (= (vector-length
- e-8904)
- 4)
- (eq? (vector-ref
- e-8904
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref e-8904 1))
- #f)))
- tmp-8902)
- (@apply
- (lambda (e-8934)
- (let ((var-8939
- (syntax->datum e-8934)))
- (begin
- (if (if (struct? val-8895)
- (eq? (struct-vtable
- val-8895)
- (vector-ref
- %expanded-vtables
- 13))
- #f)
- (let ((meta-9017
- (struct-ref
- val-8895
- 1)))
- (if (not (assq 'name
- meta-9017))
- (let ((v-9026
- (cons (cons 'name
-
var-8939)
- meta-9017)))
- (struct-set!
- val-8895
- 1
- v-9026)))))
- (analyze-variable-4233
- mod-8900
- var-8939
- (lambda (mod-9032
- var-9033
- public?-9034)
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 6)
- s-8491
- mod-9032
- var-9033
- public?-9034
- val-8895))
- (lambda (var-9045)
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 8)
- s-8491
- var-9045
- val-8895))))))
- tmp-8902)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e-8896))))))
- (let ((fun-exp-9061
- (let ((e-9069
- (list '#(syntax-object
- setter
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(key)
- #((m-*-3526 top))
- #("l-*-3527"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(type
- value
- formform
- ee
- ww
- ss
- modmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3519"
- "l-*-3520"
- "l-*-3521"
- "l-*-3522"
- "l-*-3523"
- "l-*-3524"
- "l-*-3525"))
- #(ribcage
- #(head tail val)
- #((top) (top) (top))
- #("l-*-3504"
- "l-*-3505"
- "l-*-3506"))
- #(ribcage () () ())
- #(ribcage
- #(e r w s mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3473"
- "l-*-3474"
- "l-*-3475"
- "l-*-3476"
- "l-*-3477"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- head-8878)))
+ (lambda () (gen-syntax src y r maps
ellipsis? mod))
+ (lambda (y maps)
+ (call-with-values
+ (lambda () (k maps))
+ (lambda (x maps) (values (gen-append
x y) maps)))))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if tmp-1
+ (apply (lambda (x y)
+ (call-with-values
+ (lambda () (gen-syntax src x r maps
ellipsis? mod))
+ (lambda (x maps)
(call-with-values
- (lambda ()
- (syntax-type-4296
- e-9069
- r-8489
- w-8490
- (let ((props-9079
- (source-properties
- (if (if (vector? e-9069)
- (if (=
(vector-length
- e-9069)
- 4)
- (eq? (vector-ref
- e-9069
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref e-9069 1)
- e-9069))))
- (if (pair? props-9079)
- props-9079
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-9102
- value-9103
- form-9104
- e-9105
- w-9106
- s-9107
- mod-9108)
- (expand-expr-4298
- type-9102
- value-9103
- form-9104
- e-9105
- r-8489
- w-9106
- s-9107
- mod-9108)))))
- (arg-exps-9062
- (map (lambda (e-9112)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- e-9112
- r-8489
- w-8490
- (let ((props-9127
- (source-properties
- (if (if (vector?
- e-9112)
- (if (=
(vector-length
-
e-9112)
- 4)
- (eq?
(vector-ref
-
e-9112
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- e-9112
- 1)
- e-9112))))
- (if (pair? props-9127)
- props-9127
- #f))
- #f
- mod-8492
- #f))
- (lambda (type-9160
- value-9161
- form-9162
- e-9163
- w-9164
- s-9165
- mod-9166)
- (expand-expr-4298
- type-9160
- value-9161
- form-9162
- e-9163
- r-8489
- w-9164
- s-9165
- mod-9166))))
- (append tail-8879 (list val-8880)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- s-8491
- fun-exp-9061
- arg-exps-9062))))))
- tmp-8874)
- (syntax-violation
- 'set!
- "bad set!"
- (wrap-4290
- (begin
- (if (if s-8491
- (supports-source-properties? e-8488)
- #f)
- (set-source-properties! e-8488 s-8491))
- e-8488)
- w-8490
- mod-8492))))))))
- (module-define!
- (current-module)
- '@
- (make-syntax-transformer
- '@
- 'module-ref
- (lambda (e-9208 r-9209 w-9210)
- (let ((tmp-9212
- ($sc-dispatch e-9208 '(_ each-any any))))
- (if (if tmp-9212
- (@apply
- (lambda (mod-9215 id-9216)
- (if (and-map id?-4261 mod-9215)
- (if (symbol? id-9216)
- #t
- (if (if (vector? id-9216)
- (if (= (vector-length id-9216) 4)
- (eq? (vector-ref id-9216 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref id-9216 1))
- #f))
- #f))
- tmp-9212)
- #f)
- (@apply
- (lambda (mod-9256 id-9257)
- (values
- (syntax->datum id-9257)
- r-9209
- w-9210
- #f
- (syntax->datum
- (cons '#(syntax-object
- public
- ((top)
- #(ribcage
- #(mod id)
- #((top) (top))
- #("l-*-3566" "l-*-3567"))
- #(ribcage () () ())
- #(ribcage
- #(e r w)
- #((top) (top) (top))
- #("l-*-3554" "l-*-3555" "l-*-3556"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- mod-9256))))
- tmp-9212)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-9208))))))
- (global-extend-4259
- 'module-ref
- '@@
- (lambda (e-9368 r-9369 w-9370)
- (letrec*
- ((remodulate-9371
- (lambda (x-9433 mod-9434)
- (if (pair? x-9433)
- (cons (remodulate-9371 (car x-9433) mod-9434)
- (remodulate-9371 (cdr x-9433) mod-9434))
- (if (if (vector? x-9433)
- (if (= (vector-length x-9433) 4)
- (eq? (vector-ref x-9433 0) 'syntax-object)
- #f)
- #f)
- (let ((expression-9448
- (remodulate-9371 (vector-ref x-9433 1) mod-9434))
- (wrap-9449 (vector-ref x-9433 2)))
- (vector
- 'syntax-object
- expression-9448
- wrap-9449
- mod-9434))
- (if (vector? x-9433)
- (let ((n-9457 (vector-length x-9433)))
- (let ((v-9458 (make-vector n-9457)))
- (letrec*
- ((loop-9459
- (lambda (i-9506)
- (if (= i-9506 n-9457)
- v-9458
- (begin
- (vector-set!
- v-9458
- i-9506
- (remodulate-9371
- (vector-ref x-9433 i-9506)
- mod-9434))
- (loop-9459 (#{1+}# i-9506)))))))
- (loop-9459 0))))
- x-9433))))))
- (let ((tmp-9373
- ($sc-dispatch e-9368 '(_ each-any any))))
- (if (if tmp-9373
- (@apply
- (lambda (mod-9377 exp-9378)
- (and-map id?-4261 mod-9377))
- tmp-9373)
- #f)
- (@apply
- (lambda (mod-9394 exp-9395)
- (let ((mod-9396
- (syntax->datum
- (cons '#(syntax-object
- private
- ((top)
- #(ribcage
- #(mod exp)
- #((top) (top))
- #("l-*-3604" "l-*-3605"))
- #(ribcage
- (remodulate)
- ((top))
- ("l-*-3577"))
- #(ribcage
- #(e r w)
- #((top) (top) (top))
- #("l-*-3574" "l-*-3575" "l-*-3576"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- mod-9394))))
- (values
- (remodulate-9371 exp-9395 mod-9396)
- r-9369
- w-9370
- (let ((props-9404
- (source-properties
- (if (if (vector? exp-9395)
- (if (= (vector-length exp-9395) 4)
- (eq? (vector-ref exp-9395 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref exp-9395 1)
- exp-9395))))
- (if (pair? props-9404) props-9404 #f))
- mod-9396)))
- tmp-9373)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-9368))))))
- (global-extend-4259
- 'core
- 'if
- (lambda (e-9750 r-9751 w-9752 s-9753 mod-9754)
- (let ((tmp-9756 ($sc-dispatch e-9750 '(_ any any))))
- (if tmp-9756
- (@apply
- (lambda (test-9760 then-9761)
- (let ((test-exp-9766
- (call-with-values
- (lambda ()
- (syntax-type-4296
- test-9760
- r-9751
- w-9752
- (let ((props-9788
- (source-properties
- (if (if (vector? test-9760)
- (if (= (vector-length
- test-9760)
- 4)
- (eq? (vector-ref test-9760 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref test-9760 1)
- test-9760))))
- (if (pair? props-9788) props-9788 #f))
- #f
- mod-9754
- #f))
- (lambda (type-9821
- value-9822
- form-9823
- e-9824
- w-9825
- s-9826
- mod-9827)
- (expand-expr-4298
- type-9821
- value-9822
- form-9823
- e-9824
- r-9751
- w-9825
- s-9826
- mod-9827))))
- (then-exp-9767
- (call-with-values
- (lambda ()
- (syntax-type-4296
- then-9761
- r-9751
- w-9752
- (let ((props-9845
- (source-properties
- (if (if (vector? then-9761)
- (if (= (vector-length
- then-9761)
- 4)
- (eq? (vector-ref then-9761 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref then-9761 1)
- then-9761))))
- (if (pair? props-9845) props-9845 #f))
- #f
- mod-9754
- #f))
- (lambda (type-9878
- value-9879
- form-9880
- e-9881
- w-9882
- s-9883
- mod-9884)
- (expand-expr-4298
- type-9878
- value-9879
- form-9880
- e-9881
- r-9751
- w-9882
- s-9883
- mod-9884))))
- (else-exp-9768
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 10)
- s-9753
- test-exp-9766
- then-exp-9767
- else-exp-9768)))
- tmp-9756)
- (let ((tmp-9893 ($sc-dispatch e-9750 '(_ any any any))))
- (if tmp-9893
- (@apply
- (lambda (test-9897 then-9898 else-9899)
- (let ((test-exp-9904
- (call-with-values
- (lambda ()
- (syntax-type-4296
- test-9897
- r-9751
- w-9752
- (let ((props-9926
- (source-properties
- (if (if (vector? test-9897)
- (if (= (vector-length
- test-9897)
- 4)
- (eq? (vector-ref
- test-9897
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref test-9897 1)
- test-9897))))
- (if (pair? props-9926) props-9926 #f))
- #f
- mod-9754
- #f))
- (lambda (type-9959
- value-9960
- form-9961
- e-9962
- w-9963
- s-9964
- mod-9965)
- (expand-expr-4298
- type-9959
- value-9960
- form-9961
- e-9962
- r-9751
- w-9963
- s-9964
- mod-9965))))
- (then-exp-9905
- (call-with-values
- (lambda ()
- (syntax-type-4296
- then-9898
- r-9751
- w-9752
- (let ((props-9983
- (source-properties
- (if (if (vector? then-9898)
- (if (= (vector-length
- then-9898)
- 4)
- (eq? (vector-ref
- then-9898
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref then-9898 1)
- then-9898))))
- (if (pair? props-9983) props-9983 #f))
- #f
- mod-9754
- #f))
- (lambda (type-10016
- value-10017
- form-10018
- e-10019
- w-10020
- s-10021
- mod-10022)
- (expand-expr-4298
- type-10016
- value-10017
- form-10018
- e-10019
- r-9751
- w-10020
- s-10021
- mod-10022))))
- (else-exp-9906
- (call-with-values
- (lambda ()
- (syntax-type-4296
- else-9899
- r-9751
- w-9752
- (let ((props-10040
- (source-properties
- (if (if (vector? else-9899)
- (if (= (vector-length
- else-9899)
- 4)
- (eq? (vector-ref
- else-9899
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref else-9899 1)
- else-9899))))
- (if (pair? props-10040) props-10040 #f))
- #f
- mod-9754
- #f))
- (lambda (type-10073
- value-10074
- form-10075
- e-10076
- w-10077
- s-10078
- mod-10079)
- (expand-expr-4298
- type-10073
- value-10074
- form-10075
- e-10076
- r-9751
- w-10077
- s-10078
- mod-10079)))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 10)
- s-9753
- test-exp-9904
- then-exp-9905
- else-exp-9906)))
- tmp-9893)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-9750)))))))
- (module-define!
- (current-module)
- 'with-fluids
- (make-syntax-transformer
- 'with-fluids
- 'core
- (lambda (e-10102 r-10103 w-10104 s-10105 mod-10106)
- (let ((tmp-10108
- ($sc-dispatch
- e-10102
- '(_ #(each (any any)) any . each-any))))
- (if tmp-10108
- (@apply
- (lambda (fluid-10111 val-10112 b-10113 b*-10114)
- (let ((fluids-10117
- (map (lambda (x-10125)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- x-10125
- r-10103
- w-10104
- (let ((props-10140
- (source-properties
- (if (if (vector? x-10125)
- (if (= (vector-length
- x-10125)
- 4)
- (eq? (vector-ref
- x-10125
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-10125 1)
- x-10125))))
- (if (pair? props-10140)
- props-10140
- #f))
- #f
- mod-10106
- #f))
- (lambda (type-10173
- value-10174
- form-10175
- e-10176
- w-10177
- s-10178
- mod-10179)
- (expand-expr-4298
- type-10173
- value-10174
- form-10175
- e-10176
- r-10103
- w-10177
- s-10178
- mod-10179))))
- fluid-10111))
- (vals-10118
- (map (lambda (x-10183)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- x-10183
- r-10103
- w-10104
- (let ((props-10198
- (source-properties
- (if (if (vector? x-10183)
- (if (= (vector-length
- x-10183)
- 4)
- (eq? (vector-ref
- x-10183
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-10183 1)
- x-10183))))
- (if (pair? props-10198)
- props-10198
- #f))
- #f
- mod-10106
- #f))
- (lambda (type-10231
- value-10232
- form-10233
- e-10234
- w-10235
- s-10236
- mod-10237)
- (expand-expr-4298
- type-10231
- value-10232
- form-10233
- e-10234
- r-10103
- w-10235
- s-10236
- mod-10237))))
- val-10112))
- (body-10119
- (expand-body-4301
- (cons b-10113 b*-10114)
- (wrap-4290
- (begin
- (if (if s-10105
- (supports-source-properties? e-10102)
- #f)
- (set-source-properties! e-10102 s-10105))
- e-10102)
- w-10104
- mod-10106)
- r-10103
- w-10104
- mod-10106)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 17)
- s-10105
- fluids-10117
- vals-10118
- body-10119)))
- tmp-10108)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-10102))))))
- (module-define!
- (current-module)
- 'begin
- (make-syntax-transformer 'begin 'begin '()))
- (module-define!
- (current-module)
- 'define
- (make-syntax-transformer 'define 'define '()))
- (module-define!
- (current-module)
- 'define-syntax
- (make-syntax-transformer
- 'define-syntax
- 'define-syntax
- '()))
- (module-define!
- (current-module)
- 'define-syntax-parameter
- (make-syntax-transformer
- 'define-syntax-parameter
- 'define-syntax-parameter
- '()))
- (module-define!
- (current-module)
- 'eval-when
- (make-syntax-transformer
- 'eval-when
- 'eval-when
- '()))
- (global-extend-4259
- 'core
- 'syntax-case
- (letrec*
- ((convert-pattern-10535
- (lambda (pattern-12018 keys-12019)
- (letrec*
- ((cvt*-12020
- (lambda (p*-12644 n-12645 ids-12646)
- (if (not (pair? p*-12644))
- (cvt-12022 p*-12644 n-12645 ids-12646)
+ (lambda () (gen-syntax src y r maps
ellipsis? mod))
+ (lambda (y maps) (values (gen-cons x
y) maps))))))
+ tmp-1)
+ (let ((tmp ($sc-dispatch tmp '#(vector (any .
each-any)))))
+ (if tmp
+ (apply (lambda (e1 e2)
+ (call-with-values
+ (lambda () (gen-syntax src (cons e1
e2) r maps ellipsis? mod))
+ (lambda (e maps) (values (gen-vector
e) maps))))
+ tmp)
+ (values (list 'quote e) maps))))))))))))
+ (gen-ref
+ (lambda (src var level maps)
+ (cond ((= level 0) (values var maps))
+ ((null? maps) (syntax-violation 'syntax "missing ellipsis"
src))
+ (else
+ (call-with-values
+ (lambda () (gen-ref src var (- level 1) (cdr maps)))
+ (lambda (outer-var outer-maps)
+ (let ((b (assq outer-var (car maps))))
+ (if b
+ (values (cdr b) maps)
+ (let ((inner-var (gen-var 'tmp)))
+ (values
+ inner-var
+ (cons (cons (cons outer-var inner-var) (car
maps)) outer-maps)))))))))))
+ (gen-mappend
+ (lambda (e map-env)
+ (list 'apply '(primitive append) (gen-map e map-env))))
+ (gen-map
+ (lambda (e map-env)
+ (let ((formals (map cdr map-env))
+ (actuals (map (lambda (x) (list 'ref (car x))) map-env)))
+ (cond ((eq? (car e) 'ref) (car actuals))
+ ((and-map
+ (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x)
formals)))
+ (cdr e))
+ (cons 'map
+ (cons (list 'primitive (car e))
+ (map (let ((r (map cons formals actuals)))
+ (lambda (x) (cdr (assq (cadr x) r))))
+ (cdr e)))))
+ (else (cons 'map (cons (list 'lambda formals e)
actuals)))))))
+ (gen-cons
+ (lambda (x y)
+ (let ((key (car y)))
+ (cond ((memv key '(quote))
+ (cond ((eq? (car x) 'quote) (list 'quote (cons (cadr x)
(cadr y))))
+ ((eq? (cadr y) '()) (list 'list x))
+ (else (list 'cons x y))))
+ ((memv key '(list)) (cons 'list (cons x (cdr y))))
+ (else (list 'cons x y))))))
+ (gen-append (lambda (x y) (if (equal? y ''()) x (list 'append x y))))
+ (gen-vector
+ (lambda (x)
+ (cond ((eq? (car x) 'list) (cons 'vector (cdr x)))
+ ((eq? (car x) 'quote) (list 'quote (list->vector (cadr x))))
+ (else (list 'list->vector x)))))
+ (regen (lambda (x)
+ (let ((key (car x)))
+ (cond ((memv key '(ref))
+ (build-lexical-reference 'value #f (cadr x) (cadr x)))
+ ((memv key '(primitive)) (build-primref #f (cadr x)))
+ ((memv key '(quote)) (build-data #f (cadr x)))
+ ((memv key '(lambda))
+ (if (list? (cadr x))
+ (build-simple-lambda #f (cadr x) #f (cadr x) '()
(regen (caddr x)))
+ (error "how did we get here" x)))
+ (else
+ (build-application #f (build-primref #f (car x)) (map
regen (cdr x)))))))))
+ (lambda (e r w s mod)
+ (let* ((e (source-wrap e w s mod))
+ (tmp e)
+ (tmp ($sc-dispatch tmp '(_ any))))
+ (if tmp
+ (apply (lambda (x)
+ (call-with-values
+ (lambda () (gen-syntax e x r '() ellipsis? mod))
+ (lambda (e maps) (regen e))))
+ tmp)
+ (syntax-violation 'syntax "bad `syntax' form" e))))))
+ (global-extend
+ 'core
+ 'lambda
+ (lambda (e r w s mod)
+ (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any any . each-any))))
+ (if tmp
+ (apply (lambda (args e1 e2)
+ (call-with-values
+ (lambda () (lambda-formals args))
+ (lambda (req opt rest kw)
+ (let lp ((body (cons e1 e2)) (meta '()))
+ (let* ((tmp-1 body) (tmp ($sc-dispatch tmp-1 '(any
any . each-any))))
+ (if (and tmp
+ (apply (lambda (docstring e1 e2) (string?
(syntax->datum docstring)))
+ tmp))
+ (apply (lambda (docstring e1 e2)
+ (lp (cons e1 e2)
+ (append meta (list (cons
'documentation (syntax->datum docstring))))))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(#(vector #(each
(any . any))) any . each-any))))
+ (if tmp
+ (apply (lambda (k v e1 e2)
+ (lp (cons e1 e2) (append meta
(syntax->datum (map cons k v)))))
+ tmp)
+ (expand-simple-lambda e r w s mod req rest
meta body)))))))))
+ tmp)
+ (syntax-violation 'lambda "bad lambda" e)))))
+ (global-extend
+ 'core
+ 'lambda*
+ (lambda (e r w s mod)
+ (let* ((tmp e) (tmp ($sc-dispatch tmp '(_ any any . each-any))))
+ (if tmp
+ (apply (lambda (args e1 e2)
+ (call-with-values
+ (lambda ()
+ (expand-lambda-case
+ e
+ r
+ w
+ s
+ mod
+ lambda*-formals
+ (list (cons args (cons e1 e2)))))
+ (lambda (meta lcase) (build-case-lambda s meta lcase))))
+ tmp)
+ (syntax-violation 'lambda "bad lambda*" e)))))
+ (global-extend
+ 'core
+ 'case-lambda
+ (lambda (e r w s mod)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch
+ tmp
+ '(_ (any any . each-any) . #(each (any any . each-any))))))
+ (if tmp
+ (apply (lambda (args e1 e2 args* e1* e2*)
+ (call-with-values
+ (lambda ()
+ (expand-lambda-case
+ e
+ r
+ w
+ s
+ mod
+ lambda-formals
+ (cons (cons args (cons e1 e2))
+ (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons
tmp-1 tmp-2)))
+ e2*
+ e1*
+ args*))))
+ (lambda (meta lcase) (build-case-lambda s meta lcase))))
+ tmp)
+ (syntax-violation 'case-lambda "bad case-lambda" e)))))
+ (global-extend
+ 'core
+ 'case-lambda*
+ (lambda (e r w s mod)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch
+ tmp
+ '(_ (any any . each-any) . #(each (any any . each-any))))))
+ (if tmp
+ (apply (lambda (args e1 e2 args* e1* e2*)
+ (call-with-values
+ (lambda ()
+ (expand-lambda-case
+ e
+ r
+ w
+ s
+ mod
+ lambda*-formals
+ (cons (cons args (cons e1 e2))
+ (map (lambda (tmp-2 tmp-1 tmp) (cons tmp (cons
tmp-1 tmp-2)))
+ e2*
+ e1*
+ args*))))
+ (lambda (meta lcase) (build-case-lambda s meta lcase))))
+ tmp)
+ (syntax-violation 'case-lambda "bad case-lambda*" e)))))
+ (global-extend
+ 'core
+ 'let
+ (letrec*
+ ((expand-let
+ (lambda (e r w s mod constructor ids vals exps)
+ (if (not (valid-bound-ids? ids))
+ (syntax-violation 'let "duplicate bound variable" e)
+ (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+ (let ((nw (make-binding-wrap ids labels w))
+ (nr (extend-var-env labels new-vars r)))
+ (constructor
+ s
+ (map syntax->datum ids)
+ new-vars
+ (map (lambda (x) (expand x r w mod)) vals)
+ (expand-body exps (source-wrap e nw s mod) nr nw mod))))))))
+ (lambda (e r w s mod)
+ (let* ((tmp-1 e)
+ (tmp ($sc-dispatch tmp-1 '(_ #(each (any any)) any .
each-any))))
+ (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp))
+ (apply (lambda (id val e1 e2)
+ (expand-let e r w s mod build-let id val (cons e1 e2)))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(_ any #(each (any any)) any .
each-any))))
+ (if (and tmp
+ (apply (lambda (f id val e1 e2) (and (id? f) (and-map
id? id))) tmp))
+ (apply (lambda (f id val e1 e2)
+ (expand-let e r w s mod build-named-let (cons f id)
val (cons e1 e2)))
+ tmp)
+ (syntax-violation 'let "bad let" (source-wrap e w s
mod)))))))))
+ (global-extend
+ 'core
+ 'letrec
+ (lambda (e r w s mod)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any))))
+ (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp))
+ (apply (lambda (id val e1 e2)
+ (let ((ids id))
+ (if (not (valid-bound-ids? ids))
+ (syntax-violation 'letrec "duplicate bound variable" e)
+ (let ((labels (gen-labels ids)) (new-vars (map gen-var
ids)))
+ (let ((w (make-binding-wrap ids labels w))
+ (r (extend-var-env labels new-vars r)))
+ (build-letrec
+ s
+ #f
+ (map syntax->datum ids)
+ new-vars
+ (map (lambda (x) (expand x r w mod)) val)
+ (expand-body (cons e1 e2) (source-wrap e w s mod)
r w mod)))))))
+ tmp)
+ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod))))))
+ (global-extend
+ 'core
+ 'letrec*
+ (lambda (e r w s mod)
+ (let* ((tmp e)
+ (tmp ($sc-dispatch tmp '(_ #(each (any any)) any . each-any))))
+ (if (and tmp (apply (lambda (id val e1 e2) (and-map id? id)) tmp))
+ (apply (lambda (id val e1 e2)
+ (let ((ids id))
+ (if (not (valid-bound-ids? ids))
+ (syntax-violation 'letrec* "duplicate bound variable" e)
+ (let ((labels (gen-labels ids)) (new-vars (map gen-var
ids)))
+ (let ((w (make-binding-wrap ids labels w))
+ (r (extend-var-env labels new-vars r)))
+ (build-letrec
+ s
+ #t
+ (map syntax->datum ids)
+ new-vars
+ (map (lambda (x) (expand x r w mod)) val)
+ (expand-body (cons e1 e2) (source-wrap e w s mod)
r w mod)))))))
+ tmp)
+ (syntax-violation 'letrec* "bad letrec*" (source-wrap e w s mod))))))
+ (global-extend
+ 'core
+ 'set!
+ (lambda (e r w s mod)
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ any any))))
+ (if (and tmp (apply (lambda (id val) (id? id)) tmp))
+ (apply (lambda (id val)
+ (let ((n (id-var-name id w))
+ (id-mod (if (syntax-object? id) (syntax-object-module
id) mod)))
+ (let* ((b (lookup n r id-mod)) (key (car b)))
+ (cond ((memv key '(lexical))
+ (build-lexical-assignment
+ s
+ (syntax->datum id)
+ (cdr b)
+ (expand val r w mod)))
+ ((memv key '(global))
+ (build-global-assignment s n (expand val r w
mod) id-mod))
+ ((memv key '(macro))
+ (let ((p (cdr b)))
+ (if (procedure-property p
'variable-transformer)
+ (expand (expand-macro p e r w s #f mod) r
'(()) mod)
+ (syntax-violation
+ 'set!
+ "not a variable transformer"
+ (wrap e w mod)
+ (wrap id w id-mod)))))
+ ((memv key '(displaced-lexical))
+ (syntax-violation 'set! "identifier out of
context" (wrap id w mod)))
+ (else (syntax-violation 'set! "bad set!"
(source-wrap e w s mod)))))))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(_ (any . each-any) any))))
+ (if tmp
+ (apply (lambda (head tail val)
+ (call-with-values
+ (lambda () (syntax-type head r '(()) #f #f mod #t))
+ (lambda (type value formform ee ww ss modmod)
+ (let ((key type))
+ (if (memv key '(module-ref))
+ (let ((val (expand val r w mod)))
+ (call-with-values
+ (lambda () (value (cons head tail) r w))
+ (lambda (e r w s* mod)
+ (let* ((tmp-1 e) (tmp (list tmp-1)))
+ (if (and tmp (apply (lambda (e) (id?
e)) tmp))
+ (apply (lambda (e)
(build-global-assignment s (syntax->datum e) val mod))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match
any pattern"
+ tmp-1))))))
+ (build-application
+ s
+ (expand
+ (list '#(syntax-object setter ((top))
(hygiene guile)) head)
+ r
+ w
+ mod)
+ (map (lambda (e) (expand e r w mod)) (append
tail (list val)))))))))
+ tmp)
+ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))))
+ (global-extend
+ 'module-ref
+ '@
+ (lambda (e r w)
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any))))
+ (if (and tmp
+ (apply (lambda (mod id) (and (and-map id? mod) (id? id)))
tmp))
+ (apply (lambda (mod id)
+ (values
+ (syntax->datum id)
+ r
+ w
+ #f
+ (syntax->datum
+ (cons '#(syntax-object public ((top)) (hygiene guile))
mod))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))
+ (global-extend
+ 'module-ref
+ '@@
+ (lambda (e r w)
+ (letrec*
+ ((remodulate
+ (lambda (x mod)
+ (cond ((pair? x) (cons (remodulate (car x) mod) (remodulate (cdr
x) mod)))
+ ((syntax-object? x)
+ (make-syntax-object
+ (remodulate (syntax-object-expression x) mod)
+ (syntax-object-wrap x)
+ mod))
+ ((vector? x)
+ (let* ((n (vector-length x)) (v (make-vector n)))
+ (let loop ((i 0))
+ (if (= i n)
+ (begin (if #f #f) v)
+ (begin
+ (vector-set! v i (remodulate (vector-ref x i) mod))
+ (loop (+ i 1)))))))
+ (else x)))))
+ (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ each-any any))))
+ (if (and tmp (apply (lambda (mod exp) (and-map id? mod)) tmp))
+ (apply (lambda (mod exp)
+ (let ((mod (syntax->datum
+ (cons '#(syntax-object private ((top))
(hygiene guile)) mod))))
+ (values (remodulate exp mod) r w (source-annotation
exp) mod)))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1))))))
+ (global-extend
+ 'core
+ 'if
+ (lambda (e r w s mod)
+ (let* ((tmp e) (tmp-1 ($sc-dispatch tmp '(_ any any))))
+ (if tmp-1
+ (apply (lambda (test then)
+ (build-conditional
+ s
+ (expand test r w mod)
+ (expand then r w mod)
+ (build-void #f)))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_ any any any))))
+ (if tmp-1
+ (apply (lambda (test then else)
+ (build-conditional
+ s
+ (expand test r w mod)
+ (expand then r w mod)
+ (expand else r w mod)))
+ tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp)))))))
+ (global-extend
+ 'core
+ 'with-fluids
+ (lambda (e r w s mod)
+ (let* ((tmp-1 e)
+ (tmp ($sc-dispatch tmp-1 '(_ #(each (any any)) any . each-any))))
+ (if tmp
+ (apply (lambda (fluid val b b*)
+ (build-dynlet
+ s
+ (map (lambda (x) (expand x r w mod)) fluid)
+ (map (lambda (x) (expand x r w mod)) val)
+ (expand-body (cons b b*) (source-wrap e w s mod) r w
mod)))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))
+ (global-extend 'begin 'begin '())
+ (global-extend 'define 'define '())
+ (global-extend 'define-syntax 'define-syntax '())
+ (global-extend 'define-syntax-parameter 'define-syntax-parameter '())
+ (global-extend 'eval-when 'eval-when '())
+ (global-extend
+ 'core
+ 'syntax-case
+ (letrec*
+ ((convert-pattern
+ (lambda (pattern keys)
+ (letrec*
+ ((cvt* (lambda (p* n ids)
+ (if (not (pair? p*))
+ (cvt p* n ids)
(call-with-values
- (lambda ()
- (cvt*-12020 (cdr p*-12644) n-12645 ids-12646))
- (lambda (y-12649 ids-12650)
+ (lambda () (cvt* (cdr p*) n ids))
+ (lambda (y ids)
(call-with-values
- (lambda ()
- (cvt-12022 (car p*-12644) n-12645 ids-12650))
- (lambda (x-12653 ids-12654)
- (values
- (cons x-12653 y-12649)
- ids-12654))))))))
- (v-reverse-12021
- (lambda (x-12655)
- (letrec*
- ((loop-12656
- (lambda (r-12736 x-12737)
- (if (not (pair? x-12737))
- (values r-12736 x-12737)
- (loop-12656
- (cons (car x-12737) r-12736)
- (cdr x-12737))))))
- (loop-12656 '() x-12655))))
- (cvt-12022
- (lambda (p-12025 n-12026 ids-12027)
- (if (if (symbol? p-12025)
- #t
- (if (if (vector? p-12025)
- (if (= (vector-length p-12025) 4)
- (eq? (vector-ref p-12025 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref p-12025 1))
- #f))
- (if (bound-id-member?-4289 p-12025 keys-12019)
- (values (vector 'free-id p-12025) ids-12027)
- (if (if (eq? (if (if (vector? p-12025)
- (if (= (vector-length p-12025) 4)
- (eq? (vector-ref p-12025 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref p-12025 1)
- p-12025)
- (if (if (= (vector-length
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-3705"
- "l-*-3706"
- "l-*-3707"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-3678"
- "l-*-3676"
- "l-*-3674"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-3672"
- "l-*-3673"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top)
- (top)
- (top)
- (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
-
make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '_
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-3705"
- "l-*-3706"
- "l-*-3707"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-3678"
- "l-*-3676"
- "l-*-3674"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-3672" "l-*-3673"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280 p-12025 '(()))
- (id-var-name-4280
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-3705"
- "l-*-3706"
- "l-*-3707"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-3678"
- "l-*-3676"
- "l-*-3674"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-3672" "l-*-3673"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- (values '_ ids-12027)
- (values
- 'any
- (cons (cons p-12025 n-12026) ids-12027))))
- (let ((tmp-12347 ($sc-dispatch p-12025 '(any any))))
- (if (if tmp-12347
- (@apply
- (lambda (x-12351 dots-12352)
- (if (if (if (vector? dots-12352)
- (if (= (vector-length dots-12352)
- 4)
- (eq? (vector-ref dots-12352 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref dots-12352 1))
- #f)
- (if (eq? (if (if (vector? dots-12352)
- (if (= (vector-length
- dots-12352)
- 4)
- (eq? (vector-ref
- dots-12352
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref dots-12352 1)
- dots-12352)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-2265"))
- #(ribcage
-
(lambda-var-list
- gen-var
- strip
-
expand-lambda-case
-
lambda*-formals
-
expand-simple-lambda
-
lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
-
expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
-
parse-when-list
-
expand-install-global
-
expand-top-sequence
-
expand-sequence
- source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
-
the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
- ribcage?
-
make-ribcage
- gen-labels
- gen-label
- make-rename
-
rename-marks
- rename-new
- rename-old
-
subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
- extend-env
- null-env
-
binding-value
-
binding-type
-
make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
-
syntax-object?
-
make-syntax-object
-
build-lexical-var
-
build-letrec
-
build-named-let
- build-let
-
build-sequence
- build-data
-
build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
-
build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
-
decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
-
local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
-
make-lambda-case
- make-lambda
-
make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
-
make-module-set
-
make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
- build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280
- dots-12352
- '(()))
- (id-var-name-4280
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
- transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
- set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- #f))
- tmp-12347)
- #f)
- (@apply
- (lambda (x-12452 dots-12453)
- (call-with-values
- (lambda ()
- (cvt-12022
- x-12452
- (#{1+}# n-12026)
- ids-12027))
- (lambda (p-12454 ids-12455)
- (values
- (if (eq? p-12454 'any)
- 'each-any
- (vector 'each p-12454))
- ids-12455))))
- tmp-12347)
- (let ((tmp-12456
- ($sc-dispatch p-12025 '(any any . any))))
- (if (if tmp-12456
- (@apply
- (lambda (x-12460 dots-12461 ys-12462)
- (if (if (if (vector? dots-12461)
- (if (= (vector-length
- dots-12461)
- 4)
- (eq? (vector-ref
- dots-12461
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref dots-12461 1))
- #f)
- (if (eq? (if (if (vector? dots-12461)
- (if (= (vector-length
- dots-12461)
- 4)
- (eq? (vector-ref
- dots-12461
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref dots-12461 1)
- dots-12461)
- (if (if (= (vector-length
-
'#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-2265"))
- #(ribcage
-
(lambda-var-list
- gen-var
- strip
-
expand-lambda-case
-
lambda*-formals
-
expand-simple-lambda
-
lambda-formals
-
ellipsis?
-
expand-void
-
eval-local-transformer
-
expand-local-syntax
-
expand-body
-
expand-macro
-
expand-application
-
expand-expr
- expand
-
syntax-type
-
parse-when-list
-
expand-install-global
-
expand-top-sequence
-
expand-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
-
syntax-object?
-
make-syntax-object
-
build-lexical-var
-
build-letrec
-
build-named-let
-
build-let
-
build-sequence
-
build-data
-
build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
-
build-dynlet
-
build-conditional
-
build-application
-
build-void
-
maybe-name-value!
-
decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
-
session-id
-
local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
-
lambda-meta
- lambda?
-
make-dynlet
-
make-letrec
-
make-let
-
make-lambda-case
-
make-lambda
-
make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
-
make-module-set
-
make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
-
make-const
-
make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
("l-*-476"
-
"l-*-474"
-
"l-*-472"
-
"l-*-470"
-
"l-*-468"
-
"l-*-466"
-
"l-*-464"
-
"l-*-462"
-
"l-*-460"
-
"l-*-458"
-
"l-*-456"
-
"l-*-454"
-
"l-*-452"
-
"l-*-450"
-
"l-*-448"
-
"l-*-446"
-
"l-*-444"
-
"l-*-442"
-
"l-*-440"
-
"l-*-438"
-
"l-*-436"
-
"l-*-434"
-
"l-*-432"
-
"l-*-430"
-
"l-*-428"
-
"l-*-426"
-
"l-*-424"
-
"l-*-422"
-
"l-*-420"
-
"l-*-418"
-
"l-*-416"
-
"l-*-414"
-
"l-*-412"
-
"l-*-410"
-
"l-*-408"
-
"l-*-406"
-
"l-*-404"
-
"l-*-402"
-
"l-*-400"
-
"l-*-399"
-
"l-*-397"
-
"l-*-394"
-
"l-*-393"
-
"l-*-392"
-
"l-*-390"
-
"l-*-389"
-
"l-*-387"
-
"l-*-385"
-
"l-*-383"
-
"l-*-381"
-
"l-*-379"
-
"l-*-377"
-
"l-*-375"
-
"l-*-373"
-
"l-*-370"
-
"l-*-368"
-
"l-*-367"
-
"l-*-365"
-
"l-*-363"
-
"l-*-361"
-
"l-*-359"
-
"l-*-358"
-
"l-*-357"
-
"l-*-356"
-
"l-*-354"
-
"l-*-353"
-
"l-*-350"
-
"l-*-348"
-
"l-*-346"
-
"l-*-344"
-
"l-*-342"
-
"l-*-340"
-
"l-*-338"
-
"l-*-337"
-
"l-*-336"
-
"l-*-334"
-
"l-*-332"
-
"l-*-331"
-
"l-*-328"
-
"l-*-327"
-
"l-*-325"
-
"l-*-323"
-
"l-*-321"
-
"l-*-319"
-
"l-*-317"
-
"l-*-315"
-
"l-*-313"
-
"l-*-311"
-
"l-*-309"
-
"l-*-306"
-
"l-*-304"
-
"l-*-302"
-
"l-*-300"
-
"l-*-298"
-
"l-*-296"
-
"l-*-294"
-
"l-*-292"
-
"l-*-290"
-
"l-*-288"
-
"l-*-286"
-
"l-*-284"
-
"l-*-282"
-
"l-*-280"
-
"l-*-278"
-
"l-*-276"
-
"l-*-274"
-
"l-*-272"
-
"l-*-270"
-
"l-*-268"
-
"l-*-266"
-
"l-*-264"
-
"l-*-262"
-
"l-*-260"
-
"l-*-258"
-
"l-*-256"
-
"l-*-255"
-
"l-*-254"
-
"l-*-253"
-
"l-*-252"
-
"l-*-250"
-
"l-*-248"
-
"l-*-246"
-
"l-*-243"
-
"l-*-241"
-
"l-*-239"
-
"l-*-237"
-
"l-*-235"
-
"l-*-233"
-
"l-*-231"
-
"l-*-229"
-
"l-*-227"
-
"l-*-225"
-
"l-*-223"
-
"l-*-221"
-
"l-*-219"
-
"l-*-217"
-
"l-*-215"
-
"l-*-213"
-
"l-*-211"
-
"l-*-209"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
-
"l-*-45")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
-
distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
- set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
-
make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280
- dots-12461
- '(()))
- (id-var-name-4280
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- #f))
- tmp-12456)
- #f)
- (@apply
- (lambda (x-12562 dots-12563 ys-12564)
+ (lambda () (cvt (car p*) n ids))
+ (lambda (x ids) (values (cons x y) ids))))))))
+ (v-reverse
+ (lambda (x)
+ (let loop ((r '()) (x x))
+ (if (not (pair? x)) (values r x) (loop (cons (car x) r)
(cdr x))))))
+ (cvt (lambda (p n ids)
+ (if (id? p)
+ (cond ((bound-id-member? p keys) (values (vector
'free-id p) ids))
+ ((free-id=? p '#(syntax-object _ ((top)) (hygiene
guile)))
+ (values '_ ids))
+ (else (values 'any (cons (cons p n) ids))))
+ (let* ((tmp p) (tmp-1 ($sc-dispatch tmp '(any any))))
+ (if (and tmp-1 (apply (lambda (x dots) (ellipsis?
dots)) tmp-1))
+ (apply (lambda (x dots)
(call-with-values
- (lambda ()
- (cvt*-12020
- ys-12564
- n-12026
- ids-12027))
- (lambda (ys-12567 ids-12568)
+ (lambda () (cvt x (+ n 1) ids))
+ (lambda (p ids)
+ (values (if (eq? p 'any) 'each-any
(vector 'each p)) ids))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any any . any))))
+ (if (and tmp-1 (apply (lambda (x dots ys)
(ellipsis? dots)) tmp-1))
+ (apply (lambda (x dots ys)
(call-with-values
- (lambda ()
- (cvt-12022
- x-12562
- (#{1+}# n-12026)
- ids-12568))
- (lambda (x-12569 ids-12570)
+ (lambda () (cvt* ys n ids))
+ (lambda (ys ids)
(call-with-values
- (lambda ()
- (v-reverse-12021 ys-12567))
- (lambda (ys-12603 e-12604)
- (values
- (vector
- 'each+
- x-12569
- ys-12603
- e-12604)
- ids-12570))))))))
- tmp-12456)
- (let ((tmp-12605
- ($sc-dispatch p-12025 '(any . any))))
- (if tmp-12605
- (@apply
- (lambda (x-12609 y-12610)
- (call-with-values
- (lambda ()
- (cvt-12022
- y-12610
- n-12026
- ids-12027))
- (lambda (y-12611 ids-12612)
+ (lambda () (cvt x (+ n 1) ids))
+ (lambda (x ids)
+ (call-with-values
+ (lambda () (v-reverse ys))
+ (lambda (ys e) (values
(vector 'each+ x ys e) ids))))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if tmp-1
+ (apply (lambda (x y)
(call-with-values
- (lambda ()
- (cvt-12022
- x-12609
- n-12026
- ids-12612))
- (lambda (x-12613 ids-12614)
- (values
- (cons x-12613 y-12611)
- ids-12614))))))
- tmp-12605)
- (let ((tmp-12615
- ($sc-dispatch p-12025 '())))
- (if tmp-12615
- (@apply
- (lambda () (values '() ids-12027))
- tmp-12615)
- (let ((tmp-12619
- ($sc-dispatch
- p-12025
- '#(vector each-any))))
- (if tmp-12619
- (@apply
- (lambda (x-12623)
+ (lambda () (cvt y n ids))
+ (lambda (y ids)
(call-with-values
- (lambda ()
- (cvt-12022
- x-12623
- n-12026
- ids-12027))
- (lambda (p-12624 ids-12625)
- (values
- (vector 'vector p-12624)
- ids-12625))))
- tmp-12619)
- (values
- (vector
- 'atom
- (strip-4310 p-12025 '(())))
- ids-12027)))))))))))))))
- (cvt-12022 pattern-12018 0 '()))))
- (build-dispatch-call-10536
- (lambda (pvars-12738 exp-12739 y-12740 r-12741 mod-12742)
- (let ((ids-12743 (map car pvars-12738)))
- (begin
- (map cdr pvars-12738)
- (let ((labels-12745 (gen-labels-4264 ids-12743))
- (new-vars-12746 (map gen-var-4311 ids-12743)))
- (build-application-4228
- #f
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- 'apply)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- 'apply
- #f))
- (list (build-simple-lambda-4237
- #f
- (map syntax->datum ids-12743)
- #f
- new-vars-12746
- '()
- (expand-4297
- exp-12739
- (extend-env-4255
- labels-12745
- (map (lambda (var-13069 level-13070)
- (cons 'syntax
- (cons var-13069 level-13070)))
- new-vars-12746
- (map cdr pvars-12738))
- r-12741)
- (make-binding-wrap-4275
- ids-12743
- labels-12745
- '(()))
- mod-12742))
- y-12740)))))))
- (gen-clause-10537
- (lambda (x-11400
- keys-11401
- clauses-11402
- r-11403
- pat-11404
- fender-11405
- exp-11406
- mod-11407)
- (call-with-values
- (lambda ()
- (convert-pattern-10535 pat-11404 keys-11401))
- (lambda (p-11562 pvars-11563)
- (if (not (distinct-bound-ids?-4288 (map car pvars-11563)))
- (syntax-violation
- 'syntax-case
- "duplicate pattern variable"
- pat-11404)
- (if (not (and-map
- (lambda (x-11679)
- (not (let ((x-11683 (car x-11679)))
- (if (if (if (vector? x-11683)
- (if (= (vector-length
- x-11683)
- 4)
- (eq? (vector-ref
- x-11683
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-11683 1))
- #f)
- (if (eq? (if (if (vector? x-11683)
- (if (= (vector-length
- x-11683)
- 4)
- (eq? (vector-ref
- x-11683
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref x-11683 1)
- x-11683)
- (if (if (= (vector-length
-
'#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-2265"))
- #(ribcage
-
(lambda-var-list
-
gen-var
- strip
-
expand-lambda-case
-
lambda*-formals
-
expand-simple-lambda
-
lambda-formals
-
ellipsis?
-
expand-void
-
eval-local-transformer
-
expand-local-syntax
-
expand-body
-
expand-macro
-
expand-application
-
expand-expr
- expand
-
syntax-type
-
parse-when-list
-
expand-install-global
-
expand-top-sequence
-
expand-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
-
bound-id=?
-
free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
-
id-var-name
-
same-marks?
-
join-marks
-
join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
-
new-mark
-
anti-mark
-
the-anti-mark
-
top-marked?
-
top-wrap
-
empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
-
ribcage?
-
make-ribcage
-
gen-labels
-
gen-label
-
make-rename
-
rename-marks
-
rename-new
-
rename-old
-
subst-rename?
-
wrap-subst
-
wrap-marks
-
make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
-
extend-env
-
null-env
-
binding-value
-
binding-type
-
make-binding
-
arg-check
-
source-annotation
-
no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
-
syntax-object?
-
make-syntax-object
-
build-lexical-var
-
build-letrec
-
build-named-let
-
build-let
-
build-sequence
-
build-data
-
build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
-
build-dynlet
-
build-conditional
-
build-application
-
build-void
-
maybe-name-value!
-
decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
-
session-id
-
local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
-
lambda-meta
-
lambda?
-
make-dynlet
-
make-letrec
-
make-let
-
make-lambda-case
-
make-lambda
-
make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
-
make-module-set
-
make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
-
make-const
-
make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
("l-*-476"
-
"l-*-474"
-
"l-*-472"
-
"l-*-470"
-
"l-*-468"
-
"l-*-466"
-
"l-*-464"
-
"l-*-462"
-
"l-*-460"
-
"l-*-458"
-
"l-*-456"
-
"l-*-454"
-
"l-*-452"
-
"l-*-450"
-
"l-*-448"
-
"l-*-446"
-
"l-*-444"
-
"l-*-442"
-
"l-*-440"
-
"l-*-438"
-
"l-*-436"
-
"l-*-434"
-
"l-*-432"
-
"l-*-430"
-
"l-*-428"
-
"l-*-426"
-
"l-*-424"
-
"l-*-422"
-
"l-*-420"
-
"l-*-418"
-
"l-*-416"
-
"l-*-414"
-
"l-*-412"
-
"l-*-410"
-
"l-*-408"
-
"l-*-406"
-
"l-*-404"
-
"l-*-402"
-
"l-*-400"
-
"l-*-399"
-
"l-*-397"
-
"l-*-394"
-
"l-*-393"
-
"l-*-392"
-
"l-*-390"
-
"l-*-389"
-
"l-*-387"
-
"l-*-385"
-
"l-*-383"
-
"l-*-381"
-
"l-*-379"
-
"l-*-377"
-
"l-*-375"
-
"l-*-373"
-
"l-*-370"
-
"l-*-368"
-
"l-*-367"
-
"l-*-365"
-
"l-*-363"
-
"l-*-361"
-
"l-*-359"
-
"l-*-358"
-
"l-*-357"
-
"l-*-356"
-
"l-*-354"
-
"l-*-353"
-
"l-*-350"
-
"l-*-348"
-
"l-*-346"
-
"l-*-344"
-
"l-*-342"
-
"l-*-340"
-
"l-*-338"
-
"l-*-337"
-
"l-*-336"
-
"l-*-334"
-
"l-*-332"
-
"l-*-331"
-
"l-*-328"
-
"l-*-327"
-
"l-*-325"
-
"l-*-323"
-
"l-*-321"
-
"l-*-319"
-
"l-*-317"
-
"l-*-315"
-
"l-*-313"
-
"l-*-311"
-
"l-*-309"
-
"l-*-306"
-
"l-*-304"
-
"l-*-302"
-
"l-*-300"
-
"l-*-298"
-
"l-*-296"
-
"l-*-294"
-
"l-*-292"
-
"l-*-290"
-
"l-*-288"
-
"l-*-286"
-
"l-*-284"
-
"l-*-282"
-
"l-*-280"
-
"l-*-278"
-
"l-*-276"
-
"l-*-274"
-
"l-*-272"
-
"l-*-270"
-
"l-*-268"
-
"l-*-266"
-
"l-*-264"
-
"l-*-262"
-
"l-*-260"
-
"l-*-258"
-
"l-*-256"
-
"l-*-255"
-
"l-*-254"
-
"l-*-253"
-
"l-*-252"
-
"l-*-250"
-
"l-*-248"
-
"l-*-246"
-
"l-*-243"
-
"l-*-241"
-
"l-*-239"
-
"l-*-237"
-
"l-*-235"
-
"l-*-233"
-
"l-*-231"
-
"l-*-229"
-
"l-*-227"
-
"l-*-225"
-
"l-*-223"
-
"l-*-221"
-
"l-*-219"
-
"l-*-217"
-
"l-*-215"
-
"l-*-213"
-
"l-*-211"
-
"l-*-209"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
-
("l-*-47"
-
"l-*-46"
-
"l-*-45")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
-
expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
-
distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
- syntax-object?
-
make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
-
make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280
- x-11683
- '(()))
- (id-var-name-4280
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
-
make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- #f))))
- pvars-11563))
- (syntax-violation
- 'syntax-case
- "misplaced ellipsis"
- pat-11404)
- (let ((y-11759
- (gensym
- (string-append (symbol->string 'tmp) "-"))))
- (build-application-4228
- #f
- (let ((req-11897 (list 'tmp))
- (vars-11899 (list y-11759))
- (exp-11901
- (let ((y-11918
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- 'tmp
- y-11759)))
- (let ((test-exp-11922
- (let ((tmp-11931
- ($sc-dispatch
- fender-11405
- '#(atom #t))))
- (if tmp-11931
- (@apply
- (lambda () y-11918)
- tmp-11931)
- (let ((then-exp-11946
-
(build-dispatch-call-10536
- pvars-11563
- fender-11405
- y-11918
- r-11403
- mod-11407))
- (else-exp-11947
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 1)
- #f
- #f)))
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 10)
- #f
- y-11918
- then-exp-11946
- else-exp-11947)))))
- (then-exp-11923
- (build-dispatch-call-10536
- pvars-11563
- exp-11406
- y-11918
- r-11403
- mod-11407))
- (else-exp-11924
- (gen-syntax-case-10538
- x-11400
- keys-11401
- clauses-11402
- r-11403
- mod-11407)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 10)
- #f
- test-exp-11922
- then-exp-11923
- else-exp-11924)))))
- (let ((body-11906
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- req-11897
- #f
- #f
- #f
- '()
- vars-11899
- exp-11901
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- #f
- '()
- body-11906)))
- (list (if (eq? p-11562 'any)
- (let ((fun-exp-11967
- (if (equal?
- (module-name (current-module))
- '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- 'list)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- 'list
- #f)))
- (arg-exps-11968 (list x-11400)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-11967
- arg-exps-11968))
- (let ((fun-exp-11991
- (if (equal?
- (module-name (current-module))
- '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- '$sc-dispatch)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- '$sc-dispatch
- #f)))
- (arg-exps-11992
- (list x-11400
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 1)
- #f
- p-11562))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-11991
- arg-exps-11992))))))))))))
- (gen-syntax-case-10538
- (lambda (x-10821
- keys-10822
- clauses-10823
- r-10824
- mod-10825)
- (if (null? clauses-10823)
- (let ((fun-exp-10830
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
+ (lambda () (cvt x n ids))
+ (lambda (x ids) (values
(cons x y) ids))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () (values '() ids))
tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp
'#(vector each-any))))
+ (if tmp-1
+ (apply (lambda (x)
+ (call-with-values
+ (lambda () (cvt x n ids))
+ (lambda (p ids) (values
(vector 'vector p) ids))))
+ tmp-1)
+ (let ((x tmp)) (values (vector
'atom (strip p '(()))) ids))))))))))))))))
+ (cvt pattern 0 '()))))
+ (build-dispatch-call
+ (lambda (pvars exp y r mod)
+ (let ((ids (map car pvars)) (levels (map cdr pvars)))
+ (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+ (build-application
+ #f
+ (build-primref #f 'apply)
+ (list (build-simple-lambda
+ #f
+ (map syntax->datum ids)
+ #f
+ new-vars
+ '()
+ (expand
+ exp
+ (extend-env
+ labels
+ (map (lambda (var level) (cons 'syntax (cons var
level)))
+ new-vars
+ (map cdr pvars))
+ r)
+ (make-binding-wrap ids labels '(()))
+ mod))
+ y))))))
+ (gen-clause
+ (lambda (x keys clauses r pat fender exp mod)
+ (call-with-values
+ (lambda () (convert-pattern pat keys))
+ (lambda (p pvars)
+ (cond ((not (distinct-bound-ids? (map car pvars)))
+ (syntax-violation 'syntax-case "duplicate pattern
variable" pat))
+ ((not (and-map (lambda (x) (not (ellipsis? (car x))))
pvars))
+ (syntax-violation 'syntax-case "misplaced ellipsis" pat))
+ (else
+ (let ((y (gen-var 'tmp)))
+ (build-application
+ #f
+ (build-simple-lambda
+ #f
+ (list 'tmp)
+ #f
+ (list y)
+ '()
+ (let ((y (build-lexical-reference 'value #f 'tmp
y)))
+ (build-conditional
+ #f
+ (let* ((tmp fender) (tmp ($sc-dispatch tmp
'#(atom #t))))
+ (if tmp
+ (apply (lambda () y) tmp)
+ (build-conditional
+ #f
+ y
+ (build-dispatch-call pvars fender y r
mod)
+ (build-data #f #f))))
+ (build-dispatch-call pvars exp y r mod)
+ (gen-syntax-case x keys clauses r mod))))
+ (list (if (eq? p 'any)
+ (build-application #f (build-primref #f
'list) (list x))
+ (build-application
+ #f
+ (build-primref #f '$sc-dispatch)
+ (list x (build-data #f p)))))))))))))
+ (gen-syntax-case
+ (lambda (x keys clauses r mod)
+ (if (null? clauses)
+ (build-application
+ #f
+ (build-primref #f 'syntax-violation)
+ (list (build-data #f #f)
+ (build-data #f "source expression failed to match any
pattern")
+ x))
+ (let* ((tmp-1 (car clauses)) (tmp ($sc-dispatch tmp-1 '(any
any))))
+ (if tmp
+ (apply (lambda (pat exp)
+ (if (and (id? pat)
+ (and-map
+ (lambda (x) (not (free-id=? pat x)))
+ (cons '#(syntax-object ... ((top))
(hygiene guile)) keys)))
+ (if (free-id=? pat '#(syntax-object _ ((top))
(hygiene guile)))
+ (expand exp r '(()) mod)
+ (let ((labels (list (gen-label))) (var (gen-var
pat)))
+ (build-application
+ #f
+ (build-simple-lambda
+ #f
+ (list (syntax->datum pat))
+ #f
+ (list var)
+ '()
+ (expand
+ exp
+ (extend-env labels (list (cons 'syntax
(cons var 0))) r)
+ (make-binding-wrap (list pat) labels
'(()))
+ mod))
+ (list x))))
+ (gen-clause x keys (cdr clauses) r pat #t exp
mod)))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(any any any))))
+ (if tmp
+ (apply (lambda (pat fender exp)
+ (gen-clause x keys (cdr clauses) r pat fender
exp mod))
+ tmp)
+ (syntax-violation 'syntax-case "invalid clause" (car
clauses))))))))))
+ (lambda (e r w s mod)
+ (let* ((e (source-wrap e w s mod))
+ (tmp-1 e)
+ (tmp ($sc-dispatch tmp-1 '(_ any each-any . each-any))))
+ (if tmp
+ (apply (lambda (val key m)
+ (if (and-map (lambda (x) (and (id? x) (not (ellipsis?
x)))) key)
+ (let ((x (gen-var 'tmp)))
+ (build-application
+ s
+ (build-simple-lambda
#f
- 'syntax-violation)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
+ (list 'tmp)
#f
- '(guile)
- 'syntax-violation
- #f)))
- (arg-exps-10831
- (list (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- #f)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- "source expression failed to match any
pattern")
- x-10821)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-10830
- arg-exps-10831))
- (let ((tmp-10864 (car clauses-10823)))
- (let ((tmp-10865 ($sc-dispatch tmp-10864 '(any any))))
- (if tmp-10865
- (@apply
- (lambda (pat-10867 exp-10868)
- (if (if (if (symbol? pat-10867)
- #t
- (if (if (vector? pat-10867)
- (if (= (vector-length pat-10867) 4)
- (eq? (vector-ref pat-10867 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref pat-10867 1))
- #f))
- (and-map
- (lambda (x-10895)
- (not (if (eq? (if (if (vector? pat-10867)
- (if (= (vector-length
- pat-10867)
- 4)
- (eq? (vector-ref
- pat-10867
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref pat-10867 1)
- pat-10867)
- (if (if (vector? x-10895)
- (if (= (vector-length
- x-10895)
- 4)
- (eq? (vector-ref
- x-10895
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-10895 1)
- x-10895))
- (eq? (id-var-name-4280
- pat-10867
- '(()))
- (id-var-name-4280
- x-10895
- '(())))
- #f)))
- (cons '#(syntax-object
- ...
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-3859" "l-*-3860"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top) (top) (top) (top) (top))
- #("l-*-3848"
- "l-*-3849"
- "l-*-3850"
- "l-*-3851"
- "l-*-3852"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- keys-10822))
- #f)
- (if (if (eq? (if (if (vector? pat-10867)
- (if (= (vector-length
- pat-10867)
- 4)
- (eq? (vector-ref pat-10867 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref pat-10867 1)
- pat-10867)
- (if (if (= (vector-length
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-3859"
- "l-*-3860"))
- #(ribcage () () ())
- #(ribcage
- #(x
- keys
- clauses
- r
- mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3848"
- "l-*-3849"
- "l-*-3850"
- "l-*-3851"
- "l-*-3852"))
- #(ribcage
- (gen-syntax-case
- gen-clause
-
build-dispatch-call
- convert-pattern)
- ((top)
- (top)
- (top)
- (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
-
expand-lambda-case
- lambda*-formals
-
expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
-
expand-local-syntax
- expand-body
- expand-macro
-
expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
-
expand-install-global
-
expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
-
distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
-
make-binding-wrap
- extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
- syntax-object?
-
make-syntax-object
-
build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '_
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-3859" "l-*-3860"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3848"
- "l-*-3849"
- "l-*-3850"
- "l-*-3851"
- "l-*-3852"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280 pat-10867 '(()))
- (id-var-name-4280
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-3859" "l-*-3860"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-3848"
- "l-*-3849"
- "l-*-3850"
- "l-*-3851"
- "l-*-3852"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-3668"
- "l-*-3666"
- "l-*-3664"
- "l-*-3662"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
- with-transformer-environment
- transformer-environment
- resolve-identifier
- locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
- set-syntax-object-module!
- set-syntax-object-wrap!
- set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
- syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
- build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
- get-global-definition-hook
- put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
- define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47" "l-*-46" "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- (call-with-values
- (lambda ()
- (syntax-type-4296
- exp-10868
- r-10824
- '(())
- (let ((props-11041
- (source-properties
- (if (if (vector? exp-10868)
- (if (= (vector-length
- exp-10868)
- 4)
- (eq? (vector-ref
- exp-10868
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref exp-10868 1)
- exp-10868))))
- (if (pair? props-11041) props-11041 #f))
- #f
- mod-10825
- #f))
- (lambda (type-11074
- value-11075
- form-11076
- e-11077
- w-11078
- s-11079
- mod-11080)
- (expand-expr-4298
- type-11074
- value-11075
- form-11076
- e-11077
- r-10824
- w-11078
- s-11079
- mod-11080)))
- (let ((labels-11084
- (list (string-append
- "l-"
- (session-id-4222)
- (symbol->string (gensym "-")))))
- (var-11085
- (let ((id-11123
- (if (if (vector? pat-10867)
- (if (= (vector-length
- pat-10867)
- 4)
- (eq? (vector-ref
- pat-10867
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref pat-10867 1)
- pat-10867)))
- (gensym
- (string-append
- (symbol->string id-11123)
- "-")))))
- (build-application-4228
- #f
- (build-simple-lambda-4237
- #f
- (list (syntax->datum pat-10867))
- #f
- (list var-11085)
- '()
- (expand-4297
- exp-10868
- (extend-env-4255
- labels-11084
- (list (cons 'syntax
- (cons var-11085 0)))
- r-10824)
- (make-binding-wrap-4275
- (list pat-10867)
- labels-11084
- '(()))
- mod-10825))
- (list x-10821))))
- (gen-clause-10537
- x-10821
- keys-10822
- (cdr clauses-10823)
- r-10824
- pat-10867
- #t
- exp-10868
- mod-10825)))
- tmp-10865)
- (let ((tmp-11393
- ($sc-dispatch tmp-10864 '(any any any))))
- (if tmp-11393
- (@apply
- (lambda (pat-11395 fender-11396 exp-11397)
- (gen-clause-10537
- x-10821
- keys-10822
- (cdr clauses-10823)
- r-10824
- pat-11395
- fender-11396
- exp-11397
- mod-10825))
- tmp-11393)
- (syntax-violation
- 'syntax-case
- "invalid clause"
- (car clauses-10823)))))))))))
- (lambda (e-10539 r-10540 w-10541 s-10542 mod-10543)
- (let ((e-10544
- (wrap-4290
- (begin
- (if (if s-10542
- (supports-source-properties? e-10539)
- #f)
- (set-source-properties! e-10539 s-10542))
- e-10539)
- w-10541
- mod-10543)))
- (let ((tmp-10546
- ($sc-dispatch
- e-10544
- '(_ any each-any . each-any))))
- (if tmp-10546
- (@apply
- (lambda (val-10571 key-10572 m-10573)
- (if (and-map
- (lambda (x-10574)
- (if (if (symbol? x-10574)
- #t
- (if (if (vector? x-10574)
- (if (= (vector-length x-10574) 4)
- (eq? (vector-ref x-10574 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-10574 1))
- #f))
- (not (if (if (if (vector? x-10574)
- (if (= (vector-length x-10574)
- 4)
- (eq? (vector-ref x-10574 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-10574 1))
- #f)
- (if (eq? (if (if (vector? x-10574)
- (if (= (vector-length
- x-10574)
- 4)
- (eq? (vector-ref
- x-10574
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-10574 1)
- x-10574)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-2265"))
- #(ribcage
-
(lambda-var-list
- gen-var
- strip
-
expand-lambda-case
-
lambda*-formals
-
expand-simple-lambda
-
lambda-formals
- ellipsis?
-
expand-void
-
eval-local-transformer
-
expand-local-syntax
-
expand-body
-
expand-macro
-
expand-application
-
expand-expr
- expand
-
syntax-type
-
parse-when-list
-
expand-install-global
-
expand-top-sequence
-
expand-sequence
-
source-wrap
- wrap
-
bound-id-member?
-
distinct-bound-ids?
-
valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
-
resolve-identifier
-
locally-bound-identifiers
-
id-var-name
-
same-marks?
- join-marks
- join-wraps
-
smart-append
-
make-binding-wrap
-
extend-ribcage!
-
make-empty-ribcage
- new-mark
- anti-mark
-
the-anti-mark
-
top-marked?
- top-wrap
- empty-wrap
-
set-ribcage-labels!
-
set-ribcage-marks!
-
set-ribcage-symnames!
-
ribcage-labels
-
ribcage-marks
-
ribcage-symnames
- ribcage?
-
make-ribcage
- gen-labels
- gen-label
-
make-rename
-
rename-marks
- rename-new
- rename-old
-
subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
-
id-sym-name&marks
-
id-sym-name
- id?
-
nonsymbol-id?
-
global-extend
- lookup
-
macros-only-env
-
extend-var-env
- extend-env
- null-env
-
binding-value
-
binding-type
-
make-binding
- arg-check
-
source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
-
syntax-object-module
-
syntax-object-wrap
-
syntax-object-expression
-
syntax-object?
-
make-syntax-object
-
build-lexical-var
-
build-letrec
-
build-named-let
- build-let
-
build-sequence
- build-data
-
build-primref
-
build-lambda-case
-
build-case-lambda
-
build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
-
analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
-
build-dynlet
-
build-conditional
-
build-application
- build-void
-
maybe-name-value!
-
decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
-
local-eval-hook
-
top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
-
set-lambda-meta!
-
lambda-meta
- lambda?
-
make-dynlet
-
make-letrec
- make-let
-
make-lambda-case
-
make-lambda
-
make-sequence
-
make-application
-
make-conditional
-
make-toplevel-define
-
make-toplevel-set
-
make-toplevel-ref
-
make-module-set
-
make-module-ref
-
make-lexical-set
-
make-lexical-ref
-
make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
-
(define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
-
eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
-
transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
-
set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
-
build-global-definition
-
build-global-assignment
-
build-global-reference
- analyze-variable
-
build-lexical-assignment
-
build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))))
- (eq? (id-var-name-4280 x-10574 '(()))
- (id-var-name-4280
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-2265"))
- #(ribcage
- (lambda-var-list
- gen-var
- strip
- expand-lambda-case
- lambda*-formals
- expand-simple-lambda
- lambda-formals
- ellipsis?
- expand-void
- eval-local-transformer
- expand-local-syntax
- expand-body
- expand-macro
- expand-application
- expand-expr
- expand
- syntax-type
- parse-when-list
- expand-install-global
- expand-top-sequence
- expand-sequence
- source-wrap
- wrap
- bound-id-member?
- distinct-bound-ids?
- valid-bound-ids?
- bound-id=?
- free-id=?
-
with-transformer-environment
- transformer-environment
- resolve-identifier
-
locally-bound-identifiers
- id-var-name
- same-marks?
- join-marks
- join-wraps
- smart-append
- make-binding-wrap
- extend-ribcage!
- make-empty-ribcage
- new-mark
- anti-mark
- the-anti-mark
- top-marked?
- top-wrap
- empty-wrap
- set-ribcage-labels!
- set-ribcage-marks!
- set-ribcage-symnames!
- ribcage-labels
- ribcage-marks
- ribcage-symnames
- ribcage?
- make-ribcage
- gen-labels
- gen-label
- make-rename
- rename-marks
- rename-new
- rename-old
- subst-rename?
- wrap-subst
- wrap-marks
- make-wrap
- id-sym-name&marks
- id-sym-name
- id?
- nonsymbol-id?
- global-extend
- lookup
- macros-only-env
- extend-var-env
- extend-env
- null-env
- binding-value
- binding-type
- make-binding
- arg-check
- source-annotation
- no-source
-
set-syntax-object-module!
- set-syntax-object-wrap!
-
set-syntax-object-expression!
- syntax-object-module
- syntax-object-wrap
-
syntax-object-expression
- syntax-object?
- make-syntax-object
- build-lexical-var
- build-letrec
- build-named-let
- build-let
- build-sequence
- build-data
- build-primref
- build-lambda-case
- build-case-lambda
- build-simple-lambda
- build-global-definition
- build-global-assignment
- build-global-reference
- analyze-variable
-
build-lexical-assignment
- build-lexical-reference
- build-dynlet
- build-conditional
- build-application
- build-void
- maybe-name-value!
- decorate-source
-
get-global-definition-hook
-
put-global-definition-hook
- session-id
- local-eval-hook
- top-level-eval-hook
- fx<
- fx=
- fx-
- fx+
- set-lambda-meta!
- lambda-meta
- lambda?
- make-dynlet
- make-letrec
- make-let
- make-lambda-case
- make-lambda
- make-sequence
- make-application
- make-conditional
- make-toplevel-define
- make-toplevel-set
- make-toplevel-ref
- make-module-set
- make-module-ref
- make-lexical-set
- make-lexical-ref
- make-primitive-ref
- make-const
- make-void)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-476"
- "l-*-474"
- "l-*-472"
- "l-*-470"
- "l-*-468"
- "l-*-466"
- "l-*-464"
- "l-*-462"
- "l-*-460"
- "l-*-458"
- "l-*-456"
- "l-*-454"
- "l-*-452"
- "l-*-450"
- "l-*-448"
- "l-*-446"
- "l-*-444"
- "l-*-442"
- "l-*-440"
- "l-*-438"
- "l-*-436"
- "l-*-434"
- "l-*-432"
- "l-*-430"
- "l-*-428"
- "l-*-426"
- "l-*-424"
- "l-*-422"
- "l-*-420"
- "l-*-418"
- "l-*-416"
- "l-*-414"
- "l-*-412"
- "l-*-410"
- "l-*-408"
- "l-*-406"
- "l-*-404"
- "l-*-402"
- "l-*-400"
- "l-*-399"
- "l-*-397"
- "l-*-394"
- "l-*-393"
- "l-*-392"
- "l-*-390"
- "l-*-389"
- "l-*-387"
- "l-*-385"
- "l-*-383"
- "l-*-381"
- "l-*-379"
- "l-*-377"
- "l-*-375"
- "l-*-373"
- "l-*-370"
- "l-*-368"
- "l-*-367"
- "l-*-365"
- "l-*-363"
- "l-*-361"
- "l-*-359"
- "l-*-358"
- "l-*-357"
- "l-*-356"
- "l-*-354"
- "l-*-353"
- "l-*-350"
- "l-*-348"
- "l-*-346"
- "l-*-344"
- "l-*-342"
- "l-*-340"
- "l-*-338"
- "l-*-337"
- "l-*-336"
- "l-*-334"
- "l-*-332"
- "l-*-331"
- "l-*-328"
- "l-*-327"
- "l-*-325"
- "l-*-323"
- "l-*-321"
- "l-*-319"
- "l-*-317"
- "l-*-315"
- "l-*-313"
- "l-*-311"
- "l-*-309"
- "l-*-306"
- "l-*-304"
- "l-*-302"
- "l-*-300"
- "l-*-298"
- "l-*-296"
- "l-*-294"
- "l-*-292"
- "l-*-290"
- "l-*-288"
- "l-*-286"
- "l-*-284"
- "l-*-282"
- "l-*-280"
- "l-*-278"
- "l-*-276"
- "l-*-274"
- "l-*-272"
- "l-*-270"
- "l-*-268"
- "l-*-266"
- "l-*-264"
- "l-*-262"
- "l-*-260"
- "l-*-258"
- "l-*-256"
- "l-*-255"
- "l-*-254"
- "l-*-253"
- "l-*-252"
- "l-*-250"
- "l-*-248"
- "l-*-246"
- "l-*-243"
- "l-*-241"
- "l-*-239"
- "l-*-237"
- "l-*-235"
- "l-*-233"
- "l-*-231"
- "l-*-229"
- "l-*-227"
- "l-*-225"
- "l-*-223"
- "l-*-221"
- "l-*-219"
- "l-*-217"
- "l-*-215"
- "l-*-213"
- "l-*-211"
- "l-*-209"))
- #(ribcage
- (define-structure
-
define-expansion-accessors
-
define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-47"
- "l-*-46"
- "l-*-45")))
- (hygiene guile))
- '(())))
- #f)
- #f))
- #f))
- key-10572)
- (let ((x-10700
- (gensym
- (string-append (symbol->string 'tmp) "-"))))
- (let ((fun-exp-10705
- (let ((req-10714 (list 'tmp))
- (vars-10716 (list x-10700))
- (exp-10718
- (gen-syntax-case-10538
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- 'tmp
- x-10700)
- key-10572
- m-10573
- r-10540
- mod-10543)))
- (let ((body-10723
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- req-10714
- #f
- #f
- #f
- '()
- vars-10716
- exp-10718
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- #f
- '()
- body-10723))))
- (arg-exps-10706
- (list (call-with-values
- (lambda ()
- (syntax-type-4296
- val-10571
- r-10540
- '(())
- (let ((props-10772
- (source-properties
- (if (if (vector?
- val-10571)
- (if (=
(vector-length
-
val-10571)
- 4)
- (eq?
(vector-ref
-
val-10571
- 0)
-
'syntax-object)
- #f)
- #f)
- (vector-ref
- val-10571
- 1)
- val-10571))))
- (if (pair? props-10772)
- props-10772
- #f))
- #f
- mod-10543
- #f))
- (lambda (type-10805
- value-10806
- form-10807
- e-10808
- w-10809
- s-10810
- mod-10811)
- (expand-expr-4298
- type-10805
- value-10806
- form-10807
- e-10808
- r-10540
- w-10809
- s-10810
- mod-10811))))))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- s-10542
- fun-exp-10705
- arg-exps-10706)))
- (syntax-violation
- 'syntax-case
- "invalid literals list"
- e-10544)))
- tmp-10546)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-10544)))))))
- (set! macroexpand
- (lambda*
- (x-13143
- #:optional
- (m-13144 'e)
- (esew-13145 '(eval)))
- (expand-top-sequence-4293
- (list x-13143)
- '()
- '((top))
- #f
- m-13144
- esew-13145
- (cons 'hygiene (module-name (current-module))))))
- (set! identifier?
- (lambda (x-13148)
- (if (if (vector? x-13148)
- (if (= (vector-length x-13148) 4)
- (eq? (vector-ref x-13148 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-13148 1))
- #f)))
- (set! datum->syntax
- (lambda (id-13173 datum-13174)
- (let ((wrap-13179 (vector-ref id-13173 2))
- (module-13180 (vector-ref id-13173 3)))
- (vector
- 'syntax-object
- datum-13174
- wrap-13179
- module-13180))))
- (set! syntax->datum
- (lambda (x-13187) (strip-4310 x-13187 '(()))))
- (set! syntax-source
- (lambda (x-13190)
- (let ((props-13195
- (source-properties
- (if (if (vector? x-13190)
- (if (= (vector-length x-13190) 4)
- (eq? (vector-ref x-13190 0) 'syntax-object)
- #f)
- #f)
- (vector-ref x-13190 1)
- x-13190))))
- (if (pair? props-13195) props-13195 #f))))
- (set! generate-temporaries
- (lambda (ls-13218)
- (begin
- (if (not (list? ls-13218))
- (syntax-violation
- 'generate-temporaries
- "invalid argument"
- ls-13218))
- (let ((mod-13226
- (cons 'hygiene (module-name (current-module)))))
- (map (lambda (x-13227)
- (wrap-4290 (gensym "t-") '((top)) mod-13226))
- ls-13218)))))
- (set! free-identifier=?
- (lambda (x-13231 y-13232)
- (begin
- (if (not (if (if (vector? x-13231)
- (if (= (vector-length x-13231) 4)
- (eq? (vector-ref x-13231 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-13231 1))
- #f))
- (syntax-violation
- 'free-identifier=?
- "invalid argument"
- x-13231))
- (if (not (if (if (vector? y-13232)
- (if (= (vector-length y-13232) 4)
- (eq? (vector-ref y-13232 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref y-13232 1))
- #f))
- (syntax-violation
- 'free-identifier=?
- "invalid argument"
- y-13232))
- (if (eq? (if (if (vector? x-13231)
- (if (= (vector-length x-13231) 4)
- (eq? (vector-ref x-13231 0) 'syntax-object)
- #f)
- #f)
- (vector-ref x-13231 1)
- x-13231)
- (if (if (vector? y-13232)
- (if (= (vector-length y-13232) 4)
- (eq? (vector-ref y-13232 0) 'syntax-object)
- #f)
- #f)
- (vector-ref y-13232 1)
- y-13232))
- (eq? (id-var-name-4280 x-13231 '(()))
- (id-var-name-4280 y-13232 '(())))
- #f))))
- (set! bound-identifier=?
- (lambda (x-13382 y-13383)
- (begin
- (if (not (if (if (vector? x-13382)
- (if (= (vector-length x-13382) 4)
- (eq? (vector-ref x-13382 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref x-13382 1))
- #f))
- (syntax-violation
- 'bound-identifier=?
- "invalid argument"
- x-13382))
- (if (not (if (if (vector? y-13383)
- (if (= (vector-length y-13383) 4)
- (eq? (vector-ref y-13383 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref y-13383 1))
- #f))
- (syntax-violation
- 'bound-identifier=?
- "invalid argument"
- y-13383))
- (if (if (if (vector? x-13382)
- (if (= (vector-length x-13382) 4)
- (eq? (vector-ref x-13382 0) 'syntax-object)
- #f)
- #f)
- (if (vector? y-13383)
- (if (= (vector-length y-13383) 4)
- (eq? (vector-ref y-13383 0) 'syntax-object)
- #f)
- #f)
- #f)
- (if (eq? (vector-ref x-13382 1)
- (vector-ref y-13383 1))
- (same-marks?-4279
- (car (vector-ref x-13382 2))
- (car (vector-ref y-13383 2)))
- #f)
- (eq? x-13382 y-13383)))))
- (set! syntax-violation
- (lambda*
- (who-13516
- message-13517
- form-13518
- #:optional
- (subform-13519 #f))
- (begin
- (if (not (if (not who-13516)
- (not who-13516)
- (let ((t-13537 (string? who-13516)))
- (if t-13537 t-13537 (symbol? who-13516)))))
- (syntax-violation
- 'syntax-violation
- "invalid argument"
- who-13516))
- (if (not (string? message-13517))
- (syntax-violation
- 'syntax-violation
- "invalid argument"
- message-13517))
- (throw 'syntax-error
- who-13516
- message-13517
- (let ((t-13568
- (let ((props-13627
- (source-properties
- (if (if (vector? subform-13519)
- (if (= (vector-length subform-13519)
- 4)
- (eq? (vector-ref subform-13519 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref subform-13519 1)
- subform-13519))))
- (if (pair? props-13627) props-13627 #f))))
- (if t-13568
- t-13568
- (let ((props-13600
- (source-properties
- (if (if (vector? form-13518)
- (if (= (vector-length form-13518) 4)
- (eq? (vector-ref form-13518 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref form-13518 1)
- form-13518))))
- (if (pair? props-13600) props-13600 #f))))
- (strip-4310 form-13518 '(()))
- (if subform-13519
- (strip-4310 subform-13519 '(()))
- #f)))))
- (letrec*
- ((syntax-local-binding-13655
- (lambda (id-13788)
- (begin
- (if (not (if (if (vector? id-13788)
- (if (= (vector-length id-13788) 4)
- (eq? (vector-ref id-13788 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref id-13788 1))
- #f))
- (syntax-violation
- 'syntax-local-binding
- "invalid argument"
- id-13788))
- ((fluid-ref transformer-environment-4283)
- (lambda (e-13828
- r-13829
- w-13830
- s-13831
- rib-13832
- mod-13833)
+ (list x)
+ '()
+ (gen-syntax-case
+ (build-lexical-reference 'value #f 'tmp x)
+ key
+ m
+ r
+ mod))
+ (list (expand val r '(()) mod))))
+ (syntax-violation 'syntax-case "invalid literals list"
e)))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1))))))
+ (set! macroexpand
+ (lambda* (x #:optional (m 'e) (esew '(eval)))
+ (expand-top-sequence
+ (list x)
+ '()
+ '((top))
+ #f
+ m
+ esew
+ (cons 'hygiene (module-name (current-module))))))
+ (set! identifier? (lambda (x) (nonsymbol-id? x)))
+ (set! datum->syntax
+ (lambda (id datum)
+ (make-syntax-object
+ datum
+ (syntax-object-wrap id)
+ (syntax-object-module id))))
+ (set! syntax->datum (lambda (x) (strip x '(()))))
+ (set! syntax-source (lambda (x) (source-annotation x)))
+ (set! generate-temporaries
+ (lambda (ls)
+ (let ((x ls))
+ (if (not (list? x))
+ (syntax-violation 'generate-temporaries "invalid argument" x)))
+ (let ((mod (cons 'hygiene (module-name (current-module)))))
+ (map (lambda (x) (wrap (gensym "t-") '((top)) mod)) ls))))
+ (set! free-identifier=?
+ (lambda (x y)
+ (let ((x x))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'free-identifier=? "invalid argument" x)))
+ (let ((x y))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'free-identifier=? "invalid argument" x)))
+ (free-id=? x y)))
+ (set! bound-identifier=?
+ (lambda (x y)
+ (let ((x x))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'bound-identifier=? "invalid argument" x)))
+ (let ((x y))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'bound-identifier=? "invalid argument" x)))
+ (bound-id=? x y)))
+ (set! syntax-violation
+ (lambda* (who message form #:optional (subform #f))
+ (let ((x who))
+ (if (not (let ((x x)) (or (not x) (string? x) (symbol? x))))
+ (syntax-violation 'syntax-violation "invalid argument" x)))
+ (let ((x message))
+ (if (not (string? x))
+ (syntax-violation 'syntax-violation "invalid argument" x)))
+ (throw 'syntax-error
+ who
+ message
+ (or (source-annotation subform) (source-annotation form))
+ (strip form '(()))
+ (and subform (strip subform '(()))))))
+ (letrec*
+ ((syntax-module
+ (lambda (id)
+ (let ((x id))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'syntax-module "invalid argument" x)))
+ (cdr (syntax-object-module id))))
+ (syntax-local-binding
+ (lambda (id)
+ (let ((x id))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation 'syntax-local-binding "invalid argument" x)))
+ (with-transformer-environment
+ (lambda (e r w s rib mod)
+ (letrec*
+ ((strip-anti-mark
+ (lambda (w)
+ (let ((ms (car w)) (s (cdr w)))
+ (if (and (pair? ms) (eq? (car ms) #f))
+ (cons (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
+ (cons ms (if rib (cons rib s) s)))))))
+ (call-with-values
+ (lambda ()
+ (resolve-identifier
+ (syntax-object-expression id)
+ (strip-anti-mark (syntax-object-wrap id))
+ r
+ (syntax-object-module id)))
+ (lambda (type value mod)
+ (let ((key type))
+ (cond ((memv key '(lexical)) (values 'lexical value))
+ ((memv key '(macro)) (values 'macro value))
+ ((memv key '(syntax)) (values 'pattern-variable
value))
+ ((memv key '(displaced-lexical)) (values
'displaced-lexical #f))
+ ((memv key '(global)) (values 'global (cons value
(cdr mod))))
+ (else (values 'other #f)))))))))))
+ (syntax-locally-bound-identifiers
+ (lambda (id)
+ (let ((x id))
+ (if (not (nonsymbol-id? x))
+ (syntax-violation
+ 'syntax-locally-bound-identifiers
+ "invalid argument"
+ x)))
+ (locally-bound-identifiers
+ (syntax-object-wrap id)
+ (syntax-object-module id)))))
+ (define! 'syntax-module syntax-module)
+ (define! 'syntax-local-binding syntax-local-binding)
+ (define!
+ 'syntax-locally-bound-identifiers
+ syntax-locally-bound-identifiers))
+ (letrec*
+ ((match-each
+ (lambda (e p w mod)
+ (cond ((pair? e)
+ (let ((first (match (car e) p w '() mod)))
+ (and first
+ (let ((rest (match-each (cdr e) p w mod)))
+ (and rest (cons first rest))))))
+ ((null? e) '())
+ ((syntax-object? e)
+ (match-each
+ (syntax-object-expression e)
+ p
+ (join-wraps w (syntax-object-wrap e))
+ (syntax-object-module e)))
+ (else #f))))
+ (match-each+
+ (lambda (e x-pat y-pat z-pat w r mod)
+ (let f ((e e) (w w))
+ (cond ((pair? e)
(call-with-values
- (lambda ()
- (let ((id-13836 (vector-ref id-13788 1))
- (w-13837
- (let ((w-13848 (vector-ref id-13788 2)))
- (let ((ms-13849 (car w-13848))
- (s-13850 (cdr w-13848)))
- (if (if (pair? ms-13849)
- (eq? (car ms-13849) #f)
- #f)
- (cons (cdr ms-13849)
- (if rib-13832
- (cons rib-13832 (cdr s-13850))
- (cdr s-13850)))
- (cons ms-13849
- (if rib-13832
- (cons rib-13832 s-13850)
- s-13850))))))
- (mod-13839 (vector-ref id-13788 3)))
- (let ((n-13842 (id-var-name-4280 id-13836 w-13837)))
- (if (symbol? n-13842)
- (let ((mod-13856
- (if (if (vector? id-13836)
- (if (= (vector-length id-13836) 4)
- (eq? (vector-ref id-13836 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-13836 3)
- mod-13839)))
- (let ((b-13857
- (let ((t-13858
- (get-global-definition-hook-4224
- n-13842
- mod-13856)))
- (if t-13858 t-13858 '(global)))))
- (if (eq? (car b-13857) 'global)
- (values 'global n-13842 mod-13856)
- (values
- (car b-13857)
- (cdr b-13857)
- mod-13856))))
- (if (string? n-13842)
- (let ((mod-13884
- (if (if (vector? id-13836)
- (if (= (vector-length id-13836) 4)
- (eq? (vector-ref id-13836 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-13836 3)
- mod-13839)))
- (let ((b-13885
- (let ((t-13886
- (assq-ref r-13829 n-13842)))
- (if t-13886
- t-13886
- '(displaced-lexical)))))
- (values
- (car b-13885)
- (cdr b-13885)
- mod-13884)))
- (error "unexpected id-var-name"
- id-13836
- w-13837
- n-13842))))))
- (lambda (type-13899 value-13900 mod-13901)
- (if (eqv? type-13899 'lexical)
- (values 'lexical value-13900)
- (if (eqv? type-13899 'macro)
- (values 'macro value-13900)
- (if (eqv? type-13899 'syntax)
- (values 'pattern-variable value-13900)
- (if (eqv? type-13899 'displaced-lexical)
- (values 'displaced-lexical #f)
- (if (eqv? type-13899 'global)
- (values
- 'global
- (cons value-13900 (cdr mod-13901)))
- (values 'other #f)))))))))))))
- (syntax-locally-bound-identifiers-13656
- (lambda (id-13923)
- (begin
- (if (not (if (if (vector? id-13923)
- (if (= (vector-length id-13923) 4)
- (eq? (vector-ref id-13923 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref id-13923 1))
- #f))
- (syntax-violation
- 'syntax-locally-bound-identifiers
- "invalid argument"
- id-13923))
- (locally-bound-identifiers-4281
- (vector-ref id-13923 2)
- (vector-ref id-13923 3))))))
- (begin
- (define!
- 'syntax-module
- (lambda (id-13658)
- (begin
- (if (not (if (if (vector? id-13658)
- (if (= (vector-length id-13658) 4)
- (eq? (vector-ref id-13658 0) 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref id-13658 1))
- #f))
- (syntax-violation
- 'syntax-module
- "invalid argument"
- id-13658))
- (cdr (vector-ref id-13658 3)))))
- (define!
- 'syntax-local-binding
- syntax-local-binding-13655)
- (define!
- 'syntax-locally-bound-identifiers
- syntax-locally-bound-identifiers-13656)))
- (letrec*
- ((match-each-14030
- (lambda (e-14617 p-14618 w-14619 mod-14620)
- (if (pair? e-14617)
- (let ((first-14621
- (match-14036
- (car e-14617)
- p-14618
- w-14619
- '()
- mod-14620)))
- (if first-14621
- (let ((rest-14624
- (match-each-14030
- (cdr e-14617)
- p-14618
- w-14619
- mod-14620)))
- (if rest-14624 (cons first-14621 rest-14624) #f))
- #f))
- (if (null? e-14617)
- '()
- (if (if (vector? e-14617)
- (if (= (vector-length e-14617) 4)
- (eq? (vector-ref e-14617 0) 'syntax-object)
- #f)
- #f)
- (match-each-14030
- (vector-ref e-14617 1)
- p-14618
- (join-wraps-4277 w-14619 (vector-ref e-14617 2))
- (vector-ref e-14617 3))
- #f)))))
- (match-each-any-14032
- (lambda (e-14652 w-14653 mod-14654)
- (if (pair? e-14652)
- (let ((l-14655
- (match-each-any-14032
- (cdr e-14652)
- w-14653
- mod-14654)))
- (if l-14655
- (cons (wrap-4290 (car e-14652) w-14653 mod-14654)
- l-14655)
- #f))
- (if (null? e-14652)
- '()
- (if (if (vector? e-14652)
- (if (= (vector-length e-14652) 4)
- (eq? (vector-ref e-14652 0) 'syntax-object)
- #f)
- #f)
- (match-each-any-14032
- (vector-ref e-14652 1)
- (join-wraps-4277 w-14653 (vector-ref e-14652 2))
- mod-14654)
- #f)))))
- (match-empty-14033
- (lambda (p-14679 r-14680)
- (if (null? p-14679)
- r-14680
- (if (eq? p-14679 '_)
- r-14680
- (if (eq? p-14679 'any)
- (cons '() r-14680)
- (if (pair? p-14679)
- (match-empty-14033
- (car p-14679)
- (match-empty-14033 (cdr p-14679) r-14680))
- (if (eq? p-14679 'each-any)
- (cons '() r-14680)
- (let ((key-14681 (vector-ref p-14679 0)))
- (if (eqv? key-14681 'each)
- (match-empty-14033
- (vector-ref p-14679 1)
- r-14680)
- (if (eqv? key-14681 'each+)
- (match-empty-14033
- (vector-ref p-14679 1)
- (match-empty-14033
- (reverse (vector-ref p-14679 2))
- (match-empty-14033
- (vector-ref p-14679 3)
- r-14680)))
- (if (if (eqv? key-14681 'free-id)
- #t
- (eqv? key-14681 'atom))
- r-14680
- (if (eqv? key-14681 'vector)
- (match-empty-14033
- (vector-ref p-14679 1)
- r-14680)))))))))))))
- (combine-14034
- (lambda (r*-14700 r-14701)
- (if (null? (car r*-14700))
- r-14701
- (cons (map car r*-14700)
- (combine-14034 (map cdr r*-14700) r-14701)))))
- (match*-14035
- (lambda (e-14065 p-14066 w-14067 r-14068 mod-14069)
- (if (null? p-14066)
- (if (null? e-14065) r-14068 #f)
- (if (pair? p-14066)
- (if (pair? e-14065)
- (match-14036
- (car e-14065)
- (car p-14066)
- w-14067
- (match-14036
- (cdr e-14065)
- (cdr p-14066)
- w-14067
- r-14068
- mod-14069)
- mod-14069)
- #f)
- (if (eq? p-14066 'each-any)
- (let ((l-14074
- (match-each-any-14032 e-14065 w-14067 mod-14069)))
- (if l-14074 (cons l-14074 r-14068) #f))
- (let ((key-14079 (vector-ref p-14066 0)))
- (if (eqv? key-14079 'each)
- (if (null? e-14065)
- (match-empty-14033
- (vector-ref p-14066 1)
- r-14068)
- (let ((l-14086
- (match-each-14030
- e-14065
- (vector-ref p-14066 1)
- w-14067
- mod-14069)))
- (if l-14086
- (letrec*
- ((collect-14089
- (lambda (l-14140)
- (if (null? (car l-14140))
- r-14068
- (cons (map car l-14140)
- (collect-14089
- (map cdr l-14140)))))))
- (collect-14089 l-14086))
- #f)))
- (if (eqv? key-14079 'each+)
+ (lambda () (f (cdr e) w))
+ (lambda (xr* y-pat r)
+ (if r
+ (if (null? y-pat)
+ (let ((xr (match (car e) x-pat w '() mod)))
+ (if xr (values (cons xr xr*) y-pat r) (values #f
#f #f)))
+ (values '() (cdr y-pat) (match (car e) (car y-pat) w
r mod)))
+ (values #f #f #f)))))
+ ((syntax-object? e)
+ (f (syntax-object-expression e) (join-wraps w e)))
+ (else (values '() y-pat (match e z-pat w r mod)))))))
+ (match-each-any
+ (lambda (e w mod)
+ (cond ((pair? e)
+ (let ((l (match-each-any (cdr e) w mod)))
+ (and l (cons (wrap (car e) w mod) l))))
+ ((null? e) '())
+ ((syntax-object? e)
+ (match-each-any
+ (syntax-object-expression e)
+ (join-wraps w (syntax-object-wrap e))
+ mod))
+ (else #f))))
+ (match-empty
+ (lambda (p r)
+ (cond ((null? p) r)
+ ((eq? p '_) r)
+ ((eq? p 'any) (cons '() r))
+ ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
+ ((eq? p 'each-any) (cons '() r))
+ (else
+ (let ((key (vector-ref p 0)))
+ (cond ((memv key '(each)) (match-empty (vector-ref p 1) r))
+ ((memv key '(each+))
+ (match-empty
+ (vector-ref p 1)
+ (match-empty
+ (reverse (vector-ref p 2))
+ (match-empty (vector-ref p 3) r))))
+ ((memv key '(free-id atom)) r)
+ ((memv key '(vector)) (match-empty (vector-ref p 1)
r))))))))
+ (combine
+ (lambda (r* r)
+ (if (null? (car r*)) r (cons (map car r*) (combine (map cdr r*) r)))))
+ (match*
+ (lambda (e p w r mod)
+ (cond ((null? p) (and (null? e) r))
+ ((pair? p)
+ (and (pair? e)
+ (match (car e) (car p) w (match (cdr e) (cdr p) w r mod)
mod)))
+ ((eq? p 'each-any)
+ (let ((l (match-each-any e w mod))) (and l (cons l r))))
+ (else
+ (let ((key (vector-ref p 0)))
+ (cond ((memv key '(each))
+ (if (null? e)
+ (match-empty (vector-ref p 1) r)
+ (let ((l (match-each e (vector-ref p 1) w mod)))
+ (and l
+ (let collect ((l l))
+ (if (null? (car l)) r (cons (map car l)
(collect (map cdr l)))))))))
+ ((memv key '(each+))
(call-with-values
(lambda ()
- (let ((x-pat-14149 (vector-ref p-14066 1))
- (y-pat-14150 (vector-ref p-14066 2))
- (z-pat-14151 (vector-ref p-14066 3)))
- (letrec*
- ((f-14155
- (lambda (e-14157 w-14158)
- (if (pair? e-14157)
- (call-with-values
- (lambda ()
- (f-14155 (cdr e-14157) w-14158))
- (lambda (xr*-14159
- y-pat-14160
- r-14161)
- (if r-14161
- (if (null? y-pat-14160)
- (let ((xr-14162
- (match-14036
- (car e-14157)
- x-pat-14149
- w-14158
- '()
- mod-14069)))
- (if xr-14162
- (values
- (cons xr-14162 xr*-14159)
- y-pat-14160
- r-14161)
- (values #f #f #f)))
- (values
- '()
- (cdr y-pat-14160)
- (match-14036
- (car e-14157)
- (car y-pat-14160)
- w-14158
- r-14161
- mod-14069)))
- (values #f #f #f))))
- (if (if (vector? e-14157)
- (if (= (vector-length e-14157) 4)
- (eq? (vector-ref e-14157 0)
- 'syntax-object)
- #f)
- #f)
- (f-14155
- (vector-ref e-14157 1)
- (join-wraps-4277 w-14158 e-14157))
- (values
- '()
- y-pat-14150
- (match-14036
- e-14157
- z-pat-14151
- w-14158
- r-14068
- mod-14069)))))))
- (f-14155 e-14065 w-14067))))
- (lambda (xr*-14188 y-pat-14189 r-14190)
- (if r-14190
- (if (null? y-pat-14189)
- (if (null? xr*-14188)
- (match-empty-14033
- (vector-ref p-14066 1)
- r-14190)
- (combine-14034 xr*-14188 r-14190))
- #f)
- #f)))
- (if (eqv? key-14079 'free-id)
- (if (if (symbol? e-14065)
- #t
- (if (if (vector? e-14065)
- (if (= (vector-length e-14065) 4)
- (eq? (vector-ref e-14065 0)
- 'syntax-object)
- #f)
- #f)
- (symbol? (vector-ref e-14065 1))
- #f))
- (if (let ((i-14521
- (wrap-4290 e-14065 w-14067 mod-14069))
- (j-14522 (vector-ref p-14066 1)))
- (if (eq? (if (if (vector? i-14521)
- (if (= (vector-length
- i-14521)
- 4)
- (eq? (vector-ref i-14521 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref i-14521 1)
- i-14521)
- (if (if (vector? j-14522)
- (if (= (vector-length
- j-14522)
- 4)
- (eq? (vector-ref j-14522 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref j-14522 1)
- j-14522))
- (eq? (id-var-name-4280 i-14521 '(()))
- (id-var-name-4280 j-14522 '(())))
- #f))
- r-14068
- #f)
- #f)
- (if (eqv? key-14079 'atom)
- (if (equal?
- (vector-ref p-14066 1)
- (strip-4310 e-14065 w-14067))
- r-14068
- #f)
- (if (eqv? key-14079 'vector)
- (if (vector? e-14065)
- (match-14036
- (vector->list e-14065)
- (vector-ref p-14066 1)
- w-14067
- r-14068
- mod-14069)
- #f))))))))))))
- (match-14036
- (lambda (e-14582 p-14583 w-14584 r-14585 mod-14586)
- (if (not r-14585)
- #f
- (if (eq? p-14583 '_)
- r-14585
- (if (eq? p-14583 'any)
- (cons (wrap-4290 e-14582 w-14584 mod-14586)
- r-14585)
- (if (if (vector? e-14582)
- (if (= (vector-length e-14582) 4)
- (eq? (vector-ref e-14582 0) 'syntax-object)
- #f)
- #f)
- (match*-14035
- (vector-ref e-14582 1)
- p-14583
- (join-wraps-4277 w-14584 (vector-ref e-14582 2))
- r-14585
- (vector-ref e-14582 3))
- (match*-14035
- e-14582
- p-14583
- w-14584
- r-14585
- mod-14586))))))))
- (set! $sc-dispatch
- (lambda (e-14037 p-14038)
- (if (eq? p-14038 'any)
- (list e-14037)
- (if (eq? p-14038 '_)
- '()
- (if (if (vector? e-14037)
- (if (= (vector-length e-14037) 4)
- (eq? (vector-ref e-14037 0) 'syntax-object)
- #f)
- #f)
- (match*-14035
- (vector-ref e-14037 1)
- p-14038
- (vector-ref e-14037 2)
- '()
- (vector-ref e-14037 3))
- (match*-14035 e-14037 p-14038 '(()) '() #f))))))))))
+ (match-each+
+ e
+ (vector-ref p 1)
+ (vector-ref p 2)
+ (vector-ref p 3)
+ w
+ r
+ mod))
+ (lambda (xr* y-pat r)
+ (and r
+ (null? y-pat)
+ (if (null? xr*) (match-empty (vector-ref p
1) r) (combine xr* r))))))
+ ((memv key '(free-id))
+ (and (id? e) (free-id=? (wrap e w mod) (vector-ref p
1)) r))
+ ((memv key '(atom)) (and (equal? (vector-ref p 1)
(strip e w)) r))
+ ((memv key '(vector))
+ (and (vector? e) (match (vector->list e) (vector-ref
p 1) w r mod)))))))))
+ (match (lambda (e p w r mod)
+ (cond ((not r) #f)
+ ((eq? p '_) r)
+ ((eq? p 'any) (cons (wrap e w mod) r))
+ ((syntax-object? e)
+ (match*
+ (syntax-object-expression e)
+ p
+ (join-wraps w (syntax-object-wrap e))
+ r
+ (syntax-object-module e)))
+ (else (match* e p w r mod))))))
+ (set! $sc-dispatch
+ (lambda (e p)
+ (cond ((eq? p 'any) (list e))
+ ((eq? p '_) '())
+ ((syntax-object? e)
+ (match*
+ (syntax-object-expression e)
+ p
+ (syntax-object-wrap e)
+ '()
+ (syntax-object-module e)))
+ (else (match* e p '(()) '() #f)))))))
(define with-syntax
(make-syntax-transformer
'with-syntax
'macro
- (lambda (x-25194)
- (let ((tmp-25196
- ($sc-dispatch x-25194 '(_ () any . each-any))))
- (if tmp-25196
- (@apply
- (lambda (e1-25200 e2-25201)
- (cons '#(syntax-object
- let
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25167" "l-*-25168"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25164")))
- (hygiene guile))
- (cons '() (cons e1-25200 e2-25201))))
- tmp-25196)
- (let ((tmp-25202
- ($sc-dispatch
- x-25194
- '(_ ((any any)) any . each-any))))
- (if tmp-25202
- (@apply
- (lambda (out-25206 in-25207 e1-25208 e2-25209)
- (list '#(syntax-object
- syntax-case
- ((top)
- #(ribcage
- #(out in e1 e2)
- #((top) (top) (top) (top))
- #("l-*-25173"
- "l-*-25174"
- "l-*-25175"
- "l-*-25176"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25164")))
- (hygiene guile))
- in-25207
- '()
- (list out-25206
- (cons '#(syntax-object
- let
- ((top)
- #(ribcage
- #(out in e1 e2)
- #((top) (top) (top) (top))
- #("l-*-25173"
- "l-*-25174"
- "l-*-25175"
- "l-*-25176"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25164")))
- (hygiene guile))
- (cons '() (cons e1-25208 e2-25209))))))
- tmp-25202)
- (let ((tmp-25210
- ($sc-dispatch
- x-25194
- '(_ #(each (any any)) any . each-any))))
- (if tmp-25210
- (@apply
- (lambda (out-25214 in-25215 e1-25216 e2-25217)
- (list '#(syntax-object
- syntax-case
- ((top)
- #(ribcage
- #(out in e1 e2)
- #((top) (top) (top) (top))
- #("l-*-25183"
- "l-*-25184"
- "l-*-25185"
- "l-*-25186"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25164")))
- (hygiene guile))
- (cons '#(syntax-object
- list
- ((top)
- #(ribcage
- #(out in e1 e2)
- #((top) (top) (top) (top))
- #("l-*-25183"
- "l-*-25184"
- "l-*-25185"
- "l-*-25186"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25164")))
- (hygiene guile))
- in-25215)
- '()
- (list out-25214
- (cons '#(syntax-object
- let
- ((top)
- #(ribcage
- #(out in e1 e2)
- #((top) (top) (top) (top))
- #("l-*-25183"
- "l-*-25184"
- "l-*-25185"
- "l-*-25186"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25164")))
- (hygiene guile))
- (cons '() (cons e1-25216 e2-25217))))))
- tmp-25210)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-25194))))))))))
+ (lambda (x)
+ (let ((tmp x))
+ (let ((tmp-1 ($sc-dispatch tmp '(_ () any . each-any))))
+ (if tmp-1
+ (apply (lambda (e1 e2)
+ (cons '#(syntax-object let ((top)) (hygiene guile))
+ (cons '() (cons e1 e2))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_ ((any any)) any . each-any))))
+ (if tmp-1
+ (apply (lambda (out in e1 e2)
+ (list '#(syntax-object syntax-case ((top)) (hygiene
guile))
+ in
+ '()
+ (list out
+ (cons '#(syntax-object let ((top))
(hygiene guile))
+ (cons '() (cons e1 e2))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(_ #(each (any any)) any .
each-any))))
+ (if tmp-1
+ (apply (lambda (out in e1 e2)
+ (list '#(syntax-object syntax-case ((top))
(hygiene guile))
+ (cons '#(syntax-object list ((top))
(hygiene guile)) in)
+ '()
+ (list out
+ (cons '#(syntax-object let ((top))
(hygiene guile))
+ (cons '() (cons e1 e2))))))
+ tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp)))))))))))
(define syntax-rules
(make-syntax-transformer
'syntax-rules
'macro
- (lambda (x-25271)
- (let ((tmp-25273
- ($sc-dispatch
- x-25271
- '(_ each-any . #(each ((any . any) any))))))
- (if tmp-25273
- (@apply
- (lambda (k-25277
- keyword-25278
- pattern-25279
- template-25280)
- (list '#(syntax-object
- lambda
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile)))
- (vector
- '(#(syntax-object
- macro-type
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- .
- #(syntax-object
- syntax-rules
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile)))
- (cons '#(syntax-object
- patterns
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- pattern-25279))
- (cons '#(syntax-object
- syntax-case
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- (cons '#(syntax-object
- x
- ((top)
- #(ribcage
- #(k keyword pattern template)
- #((top) (top) (top) (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- (cons k-25277
- (map (lambda (tmp-25245-25281
- tmp-25244-25282)
- (list (cons '#(syntax-object
- dummy
- ((top)
- #(ribcage
- #(k
- keyword
- pattern
- template)
- #((top)
- (top)
- (top)
- (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25231")))
- (hygiene guile))
- tmp-25244-25282)
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(k
- keyword
- pattern
- template)
- #((top)
- (top)
- (top)
- (top))
- #("l-*-25234"
- "l-*-25235"
- "l-*-25236"
- "l-*-25237"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25231")))
- (hygiene guile))
- tmp-25245-25281)))
- template-25280
- pattern-25279))))))
- tmp-25273)
- (let ((tmp-25283
- ($sc-dispatch
- x-25271
- '(_ each-any any . #(each ((any . any) any))))))
- (if (if tmp-25283
- (@apply
- (lambda (k-25287
- docstring-25288
- keyword-25289
- pattern-25290
- template-25291)
- (string? (syntax->datum docstring-25288)))
- tmp-25283)
- #f)
- (@apply
- (lambda (k-25292
- docstring-25293
- keyword-25294
- pattern-25295
- template-25296)
- (list '#(syntax-object
- lambda
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile)))
- docstring-25293
- (vector
- '(#(syntax-object
- macro-type
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- .
- #(syntax-object
- syntax-rules
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile)))
- (cons '#(syntax-object
- patterns
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- pattern-25295))
- (cons '#(syntax-object
- syntax-case
- ((top)
- #(ribcage
- #(k docstring keyword pattern template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25231")))
- (hygiene guile))
- (cons '#(syntax-object
- x
- ((top)
- #(ribcage
- #(k
- docstring
- keyword
- pattern
- template)
- #((top) (top) (top) (top) (top))
- #("l-*-25257"
- "l-*-25258"
- "l-*-25259"
- "l-*-25260"
- "l-*-25261"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25231")))
- (hygiene guile))
- (cons k-25292
- (map (lambda (tmp-25270-25297
- tmp-25269-25298)
- (list (cons '#(syntax-object
- dummy
- ((top)
- #(ribcage
- #(k
- docstring
- keyword
- pattern
- template)
- #((top)
- (top)
- (top)
- (top)
- (top))
-
#("l-*-25257"
-
"l-*-25258"
-
"l-*-25259"
-
"l-*-25260"
-
"l-*-25261"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-25231")))
- (hygiene
- guile))
- tmp-25269-25298)
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(k
- docstring
- keyword
- pattern
- template)
- #((top)
- (top)
- (top)
- (top)
- (top))
-
#("l-*-25257"
-
"l-*-25258"
-
"l-*-25259"
-
"l-*-25260"
-
"l-*-25261"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-25231")))
- (hygiene
- guile))
- tmp-25270-25297)))
- template-25296
- pattern-25295))))))
- tmp-25283)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-25271))))))))
+ (lambda (xx)
+ (let ((tmp-1 xx))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ each-any . #(each ((any . any)
any))))))
+ (if tmp
+ (apply (lambda (k keyword pattern template)
+ (list '#(syntax-object lambda ((top)) (hygiene guile))
+ '(#(syntax-object x ((top)) (hygiene guile)))
+ (vector
+ '(#(syntax-object macro-type ((top)) (hygiene
guile))
+ .
+ #(syntax-object syntax-rules ((top)) (hygiene
guile)))
+ (cons '#(syntax-object patterns ((top)) (hygiene
guile)) pattern))
+ (cons '#(syntax-object syntax-case ((top)) (hygiene
guile))
+ (cons '#(syntax-object x ((top)) (hygiene
guile))
+ (cons k
+ (map (lambda (tmp-1 tmp)
+ (list (cons
'#(syntax-object dummy ((top)) (hygiene guile)) tmp)
+ (list
'#(syntax-object syntax ((top)) (hygiene guile))
+ tmp-1)))
+ template
+ pattern))))))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(_ each-any any . #(each ((any .
any) any))))))
+ (if (if tmp
+ (apply (lambda (k docstring keyword pattern template)
+ (string? (syntax->datum docstring)))
+ tmp)
+ #f)
+ (apply (lambda (k docstring keyword pattern template)
+ (list '#(syntax-object lambda ((top)) (hygiene guile))
+ '(#(syntax-object x ((top)) (hygiene guile)))
+ docstring
+ (vector
+ '(#(syntax-object macro-type ((top)) (hygiene
guile))
+ .
+ #(syntax-object syntax-rules ((top))
(hygiene guile)))
+ (cons '#(syntax-object patterns ((top))
(hygiene guile)) pattern))
+ (cons '#(syntax-object syntax-case ((top))
(hygiene guile))
+ (cons '#(syntax-object x ((top)) (hygiene
guile))
+ (cons k
+ (map (lambda (tmp-1 tmp)
+ (list (cons
'#(syntax-object dummy ((top)) (hygiene guile)) tmp)
+ (list
'#(syntax-object syntax ((top)) (hygiene guile))
+ tmp-1)))
+ template
+ pattern))))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))))
(define define-syntax-rule
(make-syntax-transformer
'define-syntax-rule
'macro
- (lambda (x-25335)
- (let ((tmp-25337
- ($sc-dispatch x-25335 '(_ (any . any) any))))
- (if tmp-25337
- (@apply
- (lambda (name-25341 pattern-25342 template-25343)
- (list '#(syntax-object
- define-syntax
- ((top)
- #(ribcage
- #(name pattern template)
- #((top) (top) (top))
- #("l-*-25312" "l-*-25313" "l-*-25314"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25309")))
- (hygiene guile))
- name-25341
- (list '#(syntax-object
- syntax-rules
- ((top)
- #(ribcage
- #(name pattern template)
- #((top) (top) (top))
- #("l-*-25312" "l-*-25313" "l-*-25314"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25309")))
- (hygiene guile))
- '()
- (list (cons '#(syntax-object
- _
- ((top)
- #(ribcage
- #(name pattern template)
- #((top) (top) (top))
- #("l-*-25312"
- "l-*-25313"
- "l-*-25314"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25309")))
- (hygiene guile))
- pattern-25342)
- template-25343))))
- tmp-25337)
- (let ((tmp-25344
- ($sc-dispatch x-25335 '(_ (any . any) any any))))
- (if (if tmp-25344
- (@apply
- (lambda (name-25348
- pattern-25349
- docstring-25350
- template-25351)
- (string? (syntax->datum docstring-25350)))
- tmp-25344)
- #f)
- (@apply
- (lambda (name-25352
- pattern-25353
- docstring-25354
- template-25355)
- (list '#(syntax-object
- define-syntax
- ((top)
- #(ribcage
- #(name pattern docstring template)
- #((top) (top) (top) (top))
- #("l-*-25327"
- "l-*-25328"
- "l-*-25329"
- "l-*-25330"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25309")))
- (hygiene guile))
- name-25352
- (list '#(syntax-object
- syntax-rules
- ((top)
- #(ribcage
- #(name pattern docstring template)
- #((top) (top) (top) (top))
- #("l-*-25327"
- "l-*-25328"
- "l-*-25329"
- "l-*-25330"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25309")))
- (hygiene guile))
- '()
- docstring-25354
- (list (cons '#(syntax-object
- _
- ((top)
- #(ribcage
- #(name
- pattern
- docstring
- template)
- #((top) (top) (top) (top))
- #("l-*-25327"
- "l-*-25328"
- "l-*-25329"
- "l-*-25330"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25309")))
- (hygiene guile))
- pattern-25353)
- template-25355))))
- tmp-25344)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-25335))))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any))))
+ (if tmp
+ (apply (lambda (name pattern template)
+ (list '#(syntax-object define-syntax ((top)) (hygiene
guile))
+ name
+ (list '#(syntax-object syntax-rules ((top))
(hygiene guile))
+ '()
+ (list (cons '#(syntax-object _ ((top))
(hygiene guile)) pattern)
+ template))))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any any))))
+ (if (if tmp
+ (apply (lambda (name pattern docstring template)
+ (string? (syntax->datum docstring)))
+ tmp)
+ #f)
+ (apply (lambda (name pattern docstring template)
+ (list '#(syntax-object define-syntax ((top)) (hygiene
guile))
+ name
+ (list '#(syntax-object syntax-rules ((top))
(hygiene guile))
+ '()
+ docstring
+ (list (cons '#(syntax-object _ ((top))
(hygiene guile)) pattern)
+ template))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))))
(define let*
(make-syntax-transformer
'let*
'macro
- (lambda (x-25404)
- (let ((tmp-25406
- ($sc-dispatch
- x-25404
- '(any #(each (any any)) any . each-any))))
- (if (if tmp-25406
- (@apply
- (lambda (let*-25410 x-25411 v-25412 e1-25413 e2-25414)
- (and-map identifier? x-25411))
- tmp-25406)
- #f)
- (@apply
- (lambda (let*-25415 x-25416 v-25417 e1-25418 e2-25419)
- (letrec*
- ((f-25420
- (lambda (bindings-25423)
- (if (null? bindings-25423)
- (cons '#(syntax-object
- let
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(f bindings)
- #((top) (top))
- #("l-*-25390" "l-*-25391"))
- #(ribcage
- #(let* x v e1 e2)
- #((top) (top) (top) (top) (top))
- #("l-*-25380"
- "l-*-25381"
- "l-*-25382"
- "l-*-25383"
- "l-*-25384"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25366")))
- (hygiene guile))
- (cons '() (cons e1-25418 e2-25419)))
- (let ((tmp-25424
- (list (f-25420 (cdr bindings-25423))
- (car bindings-25423))))
- (let ((tmp-25425 ($sc-dispatch tmp-25424 '(any any))))
- (if tmp-25425
- (@apply
- (lambda (body-25427 binding-25428)
- (list '#(syntax-object
- let
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(body binding)
- #((top) (top))
- #("l-*-25400" "l-*-25401"))
- #(ribcage () () ())
- #(ribcage
- #(f bindings)
- #((top) (top))
- #("l-*-25390" "l-*-25391"))
- #(ribcage
- #(let* x v e1 e2)
- #((top) (top) (top) (top) (top))
- #("l-*-25380"
- "l-*-25381"
- "l-*-25382"
- "l-*-25383"
- "l-*-25384"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25366")))
- (hygiene guile))
- (list binding-25428)
- body-25427))
- tmp-25425)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-25424))))))))
- (f-25420 (map list x-25416 v-25417))))
- tmp-25406)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-25404))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(any #(each (any any)) any .
each-any))))
+ (if (if tmp
+ (apply (lambda (let* x v e1 e2) (and-map identifier? x)) tmp)
+ #f)
+ (apply (lambda (let* x v e1 e2)
+ (let f ((bindings (map list x v)))
+ (if (null? bindings)
+ (cons '#(syntax-object let ((top)) (hygiene guile))
+ (cons '() (cons e1 e2)))
+ (let ((tmp-1 (list (f (cdr bindings)) (car
bindings))))
+ (let ((tmp ($sc-dispatch tmp-1 '(any any))))
+ (if tmp
+ (apply (lambda (body binding)
+ (list '#(syntax-object let ((top))
(hygiene guile))
+ (list binding)
+ body))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1)))))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))
(define do
(make-syntax-transformer
'do
'macro
- (lambda (orig-x-25484)
- (let ((tmp-25486
- ($sc-dispatch
- orig-x-25484
- '(_ #(each (any any . any))
- (any . each-any)
- .
- each-any))))
- (if tmp-25486
- (@apply
- (lambda (var-25490
- init-25491
- step-25492
- e0-25493
- e1-25494
- c-25495)
- (let ((tmp-25496
- (map (lambda (v-25499 s-25500)
- (let ((tmp-25502 ($sc-dispatch s-25500 '())))
- (if tmp-25502
- (@apply (lambda () v-25499) tmp-25502)
- (let ((tmp-25505
- ($sc-dispatch s-25500 '(any))))
- (if tmp-25505
- (@apply
- (lambda (e-25508) e-25508)
- tmp-25505)
- (syntax-violation
- 'do
- "bad step expression"
- orig-x-25484
- s-25500))))))
- var-25490
- step-25492)))
- (let ((tmp-25497 ($sc-dispatch tmp-25496 'each-any)))
- (if tmp-25497
- (@apply
- (lambda (step-25513)
- (let ((tmp-25515 ($sc-dispatch e1-25494 '())))
- (if tmp-25515
- (@apply
- (lambda ()
- (list '#(syntax-object
- let
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- '#(syntax-object
- doloop
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (map list var-25490 init-25491)
- (list '#(syntax-object
- if
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (list '#(syntax-object
- not
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var
- init
- step
- e0
- e1
- c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- e0-25493)
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var
- init
- step
- e0
- e1
- c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (append
- c-25495
- (list (cons
'#(syntax-object
- doloop
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(step)
- #((top))
-
#("l-*-25454"))
- #(ribcage
- #(var
- init
- step
- e0
- e1
- c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
#("l-*-25439"
-
"l-*-25440"
-
"l-*-25441"
-
"l-*-25442"
-
"l-*-25443"
-
"l-*-25444"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(orig-x)
- #((top))
-
#("l-*-25436")))
- (hygiene
- guile))
-
step-25513)))))))
- tmp-25515)
- (let ((tmp-25519
- ($sc-dispatch e1-25494 '(any . each-any))))
- (if tmp-25519
- (@apply
- (lambda (e1-25523 e2-25524)
- (list '#(syntax-object
- let
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25463" "l-*-25464"))
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- '#(syntax-object
- doloop
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25463" "l-*-25464"))
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (map list var-25490 init-25491)
- (list '#(syntax-object
- if
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25463"
- "l-*-25464"))
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var init step e0 e1 c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- e0-25493
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25463"
- "l-*-25464"))
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var
- init
- step
- e0
- e1
- c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (cons e1-25523 e2-25524))
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-25463"
- "l-*-25464"))
- #(ribcage () () ())
- #(ribcage
- #(step)
- #((top))
- #("l-*-25454"))
- #(ribcage
- #(var
- init
- step
- e0
- e1
- c)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-25439"
- "l-*-25440"
- "l-*-25441"
- "l-*-25442"
- "l-*-25443"
- "l-*-25444"))
- #(ribcage () () ())
- #(ribcage
- #(orig-x)
- #((top))
- #("l-*-25436")))
- (hygiene guile))
- (append
- c-25495
- (list (cons
'#(syntax-object
- doloop
- ((top)
-
#(ribcage
- #(e1
- e2)
-
#((top)
-
(top))
-
#("l-*-25463"
-
"l-*-25464"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
-
#(step)
-
#((top))
-
#("l-*-25454"))
-
#(ribcage
- #(var
-
init
-
step
- e0
- e1
- c)
-
#((top)
-
(top)
-
(top)
-
(top)
-
(top)
-
(top))
-
#("l-*-25439"
-
"l-*-25440"
-
"l-*-25441"
-
"l-*-25442"
-
"l-*-25443"
-
"l-*-25444"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
-
#(orig-x)
-
#((top))
-
#("l-*-25436")))
- (hygiene
-
guile))
-
step-25513)))))))
- tmp-25519)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- e1-25494))))))
- tmp-25497)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-25496)))))
- tmp-25486)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- orig-x-25484))))))
+ (lambda (orig-x)
+ (let ((tmp-1 orig-x))
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(_ #(each (any any . any)) (any . each-any) .
each-any))))
+ (if tmp
+ (apply (lambda (var init step e0 e1 c)
+ (let ((tmp-1 (map (lambda (v s)
+ (let ((tmp-1 s))
+ (let ((tmp ($sc-dispatch tmp-1
'())))
+ (if tmp
+ (apply (lambda () v) tmp)
+ (let ((tmp ($sc-dispatch tmp-1
'(any))))
+ (if tmp
+ (apply (lambda (e) e) tmp)
+ (syntax-violation 'do "bad
step expression" orig-x s)))))))
+ var
+ step)))
+ (let ((tmp ($sc-dispatch tmp-1 'each-any)))
+ (if tmp
+ (apply (lambda (step)
+ (let ((tmp e1))
+ (let ((tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda ()
+ (list '#(syntax-object let
((top)) (hygiene guile))
+ '#(syntax-object
doloop ((top)) (hygiene guile))
+ (map list var init)
+ (list
'#(syntax-object if ((top)) (hygiene guile))
+ (list
'#(syntax-object not ((top)) (hygiene guile)) e0)
+ (cons
'#(syntax-object begin ((top)) (hygiene guile))
+ (append
+ c
+ (list
(cons '#(syntax-object
+
doloop
+
((top))
+
(hygiene guile))
+
step)))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any
. each-any))))
+ (if tmp-1
+ (apply (lambda (e1 e2)
+ (list '#(syntax-object
let ((top)) (hygiene guile))
+ '#(syntax-object
doloop ((top)) (hygiene guile))
+ (map list var
init)
+ (list
'#(syntax-object if ((top)) (hygiene guile))
+ e0
+ (cons
'#(syntax-object begin ((top)) (hygiene guile))
+ (cons
e1 e2))
+ (cons
'#(syntax-object begin ((top)) (hygiene guile))
+
(append
+ c
+
(list (cons '#(syntax-object
+
doloop
+
((top))
+
(hygiene guile))
+
step)))))))
+ tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to
match any pattern"
+ tmp)))))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
'macro
(letrec*
- ((quasi-25792
- (lambda (p-25816 lev-25817)
- (let ((tmp-25819
- ($sc-dispatch
- p-25816
- '(#(free-id
- #(syntax-object
- unquote
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- any))))
- (if tmp-25819
- (@apply
- (lambda (p-25823)
- (if (= lev-25817 0)
- (list '#(syntax-object
- "value"
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25560"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- p-25823)
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25560"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- unquote
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25560"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792 (list p-25823) (#{1-}# lev-25817)))))
- tmp-25819)
- (let ((tmp-25826
- ($sc-dispatch
- p-25816
- '(#(free-id
- #(syntax-object
- quasiquote
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- any))))
- (if tmp-25826
- (@apply
- (lambda (p-25830)
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25563"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- quasiquote
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25563"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792 (list p-25830) (#{1+}# lev-25817))))
- tmp-25826)
- (let ((tmp-25833 ($sc-dispatch p-25816 '(any . any))))
- (if tmp-25833
- (@apply
- (lambda (p-25837 q-25838)
- (let ((tmp-25840
- ($sc-dispatch
- p-25837
- '(#(free-id
- #(syntax-object
- unquote
- ((top)
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- .
- each-any))))
- (if tmp-25840
- (@apply
- (lambda (p-25844)
- (if (= lev-25817 0)
- (quasilist*-25796
- (map (lambda (tmp-25574-25880)
- (list '#(syntax-object
- "value"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25572"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566"
- "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556"
- "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- tmp-25574-25880))
- p-25844)
- (quasi-25792 q-25838 lev-25817))
- (quasicons-25794
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25572"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- unquote
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25572"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792
- p-25844
- (#{1-}# lev-25817)))
- (quasi-25792 q-25838 lev-25817))))
- tmp-25840)
- (let ((tmp-25885
- ($sc-dispatch
- p-25837
- '(#(free-id
- #(syntax-object
- unquote-splicing
- ((top)
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- .
- each-any))))
- (if tmp-25885
- (@apply
- (lambda (p-25889)
- (if (= lev-25817 0)
- (quasiappend-25795
- (map (lambda (tmp-25579-25892)
- (list '#(syntax-object
- "value"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25577"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566"
- "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556"
- "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- tmp-25579-25892))
- p-25889)
- (quasi-25792 q-25838 lev-25817))
- (quasicons-25794
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25577"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- unquote-splicing
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25577"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25566" "l-*-25567"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792
- p-25889
- (#{1-}# lev-25817)))
- (quasi-25792 q-25838 lev-25817))))
- tmp-25885)
- (quasicons-25794
- (quasi-25792 p-25837 lev-25817)
- (quasi-25792 q-25838 lev-25817)))))))
- tmp-25833)
- (let ((tmp-25905
- ($sc-dispatch p-25816 '#(vector each-any))))
- (if tmp-25905
- (@apply
- (lambda (x-25909)
- (let ((x-25912
- (vquasi-25793 x-25909 lev-25817)))
- (let ((tmp-25914
- ($sc-dispatch
- x-25912
- '(#(atom "quote") each-any))))
- (if tmp-25914
- (@apply
- (lambda (x-25916)
- (list '#(syntax-object
- "quote"
- ((top)
- #(ribcage
- #(x)
- #((top))
- #("l-*-25668"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25665"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- (list->vector x-25916)))
- tmp-25914)
- (letrec*
- ((f-25917
- (lambda (y-25929 k-25930)
- (let ((tmp-25932
- ($sc-dispatch
- y-25929
- '(#(atom "quote")
+ ((quasi (lambda (p lev)
+ (let ((tmp p))
+ (let ((tmp-1 ($sc-dispatch
+ tmp
+ '(#(free-id #(syntax-object unquote ((top))
(hygiene guile))) any))))
+ (if tmp-1
+ (apply (lambda (p)
+ (if (= lev 0)
+ (list "value" p)
+ (quasicons
+ '("quote" #(syntax-object unquote ((top))
(hygiene guile)))
+ (quasi (list p) (- lev 1)))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch
+ tmp
+ '(#(free-id #(syntax-object quasiquote
((top)) (hygiene guile))) any))))
+ (if tmp-1
+ (apply (lambda (p)
+ (quasicons
+ '("quote" #(syntax-object quasiquote
((top)) (hygiene guile)))
+ (quasi (list p) (+ lev 1))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if tmp-1
+ (apply (lambda (p q)
+ (let ((tmp-1 p))
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(#(free-id
#(syntax-object unquote ((top)) (hygiene guile)))
+ .
each-any))))
- (if tmp-25932
- (@apply
- (lambda (y-25935)
- (k-25930
- (map (lambda
(tmp-25691-25936)
- (list
'#(syntax-object
- "quote"
- ((top)
-
#(ribcage
- #(y)
-
#((top))
-
#("l-*-25689"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- #(f
- y
- k)
-
#((top)
-
(top)
-
(top))
-
#("l-*-25671"
-
"l-*-25672"
-
"l-*-25673"))
-
#(ribcage
- ()
- ()
- ())
-
#(ribcage
- #(x)
-
#((top))
-
#("l-*-25665"))
-
#(ribcage
- (emit
quasivector
-
quasilist*
-
quasiappend
-
quasicons
-
vquasi
-
quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
-
(top))
-
("l-*-25552"
-
"l-*-25550"
-
"l-*-25548"
-
"l-*-25546"
-
"l-*-25544"
-
"l-*-25542"
-
"l-*-25540")))
- (hygiene
- guile))
-
tmp-25691-25936))
- y-25935)))
- tmp-25932)
- (let ((tmp-25937
- ($sc-dispatch
- y-25929
- '(#(atom "list")
+ (if tmp
+ (apply (lambda (p)
+ (if (= lev 0)
+ (quasilist*
+ (map (lambda (tmp)
(list "value" tmp)) p)
+ (quasi q lev))
+ (quasicons
+ (quasicons
+ '("quote"
#(syntax-object unquote ((top)) (hygiene guile)))
+ (quasi p (- lev
1)))
+ (quasi q lev))))
+ tmp)
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(#(free-id
+ #(syntax-object
unquote-splicing ((top)) (hygiene guile)))
.
each-any))))
- (if tmp-25937
- (@apply
- (lambda (y-25940)
- (k-25930 y-25940))
- tmp-25937)
- (let ((tmp-25941
- ($sc-dispatch
- y-25929
- '(#(atom "list*")
- .
- #(each+
- any
- (any)
- ())))))
- (if tmp-25941
- (@apply
- (lambda (y-25944
- z-25945)
- (f-25917
- z-25945
- (lambda
(ls-25946)
- (k-25930
- (append
- y-25944
-
ls-25946)))))
- tmp-25941)
- (list '#(syntax-object
- "list->vector"
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(t-25706)
-
#((m-*-25707
- top))
-
#("l-*-25710"))
- #(ribcage
- #(else)
- #((top))
-
#("l-*-25704"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(f y k)
- #((top)
- (top)
- (top))
-
#("l-*-25671"
-
"l-*-25672"
-
"l-*-25673"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-25665"))
- #(ribcage
- (emit
quasivector
-
quasilist*
-
quasiappend
-
quasicons
-
vquasi
-
quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
-
("l-*-25552"
-
"l-*-25550"
-
"l-*-25548"
-
"l-*-25546"
-
"l-*-25544"
-
"l-*-25542"
-
"l-*-25540")))
- (hygiene
- guile))
- x-25912))))))))))
- (f-25917
- x-25912
- (lambda (ls-25919)
- (let ((tmp-25921
- ($sc-dispatch
- ls-25919
- 'each-any)))
- (if tmp-25921
- (@apply
- (lambda (t-25679-25924)
- (cons '#(syntax-object
- "vector"
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(t-25679)
- #((m-*-25680
- top))
- #("l-*-25684"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(ls)
- #((top))
- #("l-*-25678"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25665"))
- #(ribcage
- (emit
quasivector
- quasilist*
-
quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- t-25679-25924))
- tmp-25921)
- (syntax-violation
- #f
- "source expression failed to
match any pattern"
- ls-25919))))))))))
- tmp-25905)
- (list '#(syntax-object
- "quote"
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25585"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25556" "l-*-25557"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- p-25816)))))))))))
- (vquasi-25793
- (lambda (p-25972 lev-25973)
- (let ((tmp-25975 ($sc-dispatch p-25972 '(any . any))))
- (if tmp-25975
- (@apply
- (lambda (p-25979 q-25980)
- (let ((tmp-25982
- ($sc-dispatch
- p-25979
- '(#(free-id
- #(syntax-object
- unquote
- ((top)
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- .
- each-any))))
- (if tmp-25982
- (@apply
- (lambda (p-25986)
- (if (= lev-25973 0)
- (quasilist*-25796
- (map (lambda (tmp-25601-26022)
- (list '#(syntax-object
- "value"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25599"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- tmp-25601-26022))
- p-25986)
- (vquasi-25793 q-25980 lev-25973))
- (quasicons-25794
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25599"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- unquote
- ((top)
- #(ribcage #(p) #((top)) #("l-*-25599"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792 p-25986 (#{1-}# lev-25973)))
- (vquasi-25793 q-25980 lev-25973))))
- tmp-25982)
- (let ((tmp-26029
- ($sc-dispatch
- p-25979
- '(#(free-id
- #(syntax-object
- unquote-splicing
- ((top)
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- .
- each-any))))
- (if tmp-26029
- (@apply
- (lambda (p-26033)
- (if (= lev-25973 0)
- (quasiappend-25795
- (map (lambda (tmp-25606-26036)
- (list '#(syntax-object
- "value"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25604"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593"
- "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589"
- "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- tmp-25606-26036))
- p-26033)
- (vquasi-25793 q-25980 lev-25973))
- (quasicons-25794
- (quasicons-25794
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25604"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- #(syntax-object
- unquote-splicing
- ((top)
- #(ribcage
- #(p)
- #((top))
- #("l-*-25604"))
- #(ribcage
- #(p q)
- #((top) (top))
- #("l-*-25593" "l-*-25594"))
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile)))
- (quasi-25792 p-26033 (#{1-}# lev-25973)))
- (vquasi-25793 q-25980 lev-25973))))
- tmp-26029)
- (quasicons-25794
- (quasi-25792 p-25979 lev-25973)
- (vquasi-25793 q-25980 lev-25973)))))))
- tmp-25975)
- (let ((tmp-26053 ($sc-dispatch p-25972 '())))
- (if tmp-26053
- (@apply
- (lambda ()
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p lev)
- #((top) (top))
- #("l-*-25589" "l-*-25590"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- ()))
- tmp-26053)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- p-25972)))))))
- (quasicons-25794
- (lambda (x-26066 y-26067)
- (let ((tmp-26068 (list x-26066 y-26067)))
- (let ((tmp-26069 ($sc-dispatch tmp-26068 '(any any))))
- (if tmp-26069
- (@apply
- (lambda (x-26071 y-26072)
- (let ((tmp-26074
- ($sc-dispatch y-26072 '(#(atom "quote") any))))
- (if tmp-26074
- (@apply
- (lambda (dy-26078)
- (let ((tmp-26080
- ($sc-dispatch
- x-26071
- '(#(atom "quote") any))))
- (if tmp-26080
- (@apply
- (lambda (dx-26082)
- (list '#(syntax-object
- "quote"
- ((top)
- #(ribcage
- #(dx)
- #((top))
- #("l-*-25626"))
- #(ribcage
- #(dy)
- #((top))
- #("l-*-25622"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- (cons dx-26082 dy-26078)))
- tmp-26080)
- (if (null? dy-26078)
- (list '#(syntax-object
- "list"
- ((top)
- #(ribcage
- #(dy)
- #((top))
- #("l-*-25622"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- x-26071)
- (list '#(syntax-object
- "list*"
- ((top)
- #(ribcage
- #(dy)
- #((top))
- #("l-*-25622"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- x-26071
- y-26072)))))
- tmp-26074)
- (let ((tmp-26084
- ($sc-dispatch
- y-26072
- '(#(atom "list") . any))))
- (if tmp-26084
- (@apply
- (lambda (stuff-26088)
- (cons '#(syntax-object
- "list"
- ((top)
- #(ribcage
- #(stuff)
- #((top))
- #("l-*-25629"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- (cons x-26071 stuff-26088)))
- tmp-26084)
- (let ((tmp-26089
- ($sc-dispatch
- y-26072
- '(#(atom "list*") . any))))
- (if tmp-26089
- (@apply
- (lambda (stuff-26093)
- (cons '#(syntax-object
- "list*"
- ((top)
- #(ribcage
- #(stuff)
- #((top))
- #("l-*-25632"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- (cons x-26071 stuff-26093)))
- tmp-26089)
- (list '#(syntax-object
- "list*"
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25616" "l-*-25617"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25611" "l-*-25612"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- x-26071
- y-26072))))))))
- tmp-26069)
+ (if tmp
+ (apply (lambda (p)
+ (if (= lev 0)
+ (quasiappend
+ (map (lambda
(tmp) (list "value" tmp)) p)
+ (quasi q lev))
+ (quasicons
+ (quasicons
+ '("quote"
+
#(syntax-object
+
unquote-splicing
+ ((top))
+ (hygiene
guile)))
+ (quasi p (-
lev 1)))
+ (quasi q lev))))
+ tmp)
+ (quasicons (quasi p lev)
(quasi q lev))))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '#(vector
each-any))))
+ (if tmp-1
+ (apply (lambda (x) (quasivector (vquasi x
lev))) tmp-1)
+ (let ((p tmp)) (list "quote" p)))))))))))))
+ (vquasi
+ (lambda (p lev)
+ (let ((tmp p))
+ (let ((tmp-1 ($sc-dispatch tmp '(any . any))))
+ (if tmp-1
+ (apply (lambda (p q)
+ (let ((tmp-1 p))
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(#(free-id #(syntax-object unquote
((top)) (hygiene guile)))
+ .
+ each-any))))
+ (if tmp
+ (apply (lambda (p)
+ (if (= lev 0)
+ (quasilist* (map (lambda (tmp)
(list "value" tmp)) p) (vquasi q lev))
+ (quasicons
+ (quasicons
+ '("quote" #(syntax-object
unquote ((top)) (hygiene guile)))
+ (quasi p (- lev 1)))
+ (vquasi q lev))))
+ tmp)
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(#(free-id #(syntax-object
unquote-splicing ((top)) (hygiene guile)))
+ .
+ each-any))))
+ (if tmp
+ (apply (lambda (p)
+ (if (= lev 0)
+ (quasiappend
+ (map (lambda (tmp) (list
"value" tmp)) p)
+ (vquasi q lev))
+ (quasicons
+ (quasicons
+ '("quote" #(syntax-object
unquote-splicing ((top)) (hygiene guile)))
+ (quasi p (- lev 1)))
+ (vquasi q lev))))
+ tmp)
+ (quasicons (quasi p lev) (vquasi q
lev))))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '())))
+ (if tmp-1
+ (apply (lambda () '("quote" ())) tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp))))))))
+ (quasicons
+ (lambda (x y)
+ (let ((tmp-1 (list x y)))
+ (let ((tmp ($sc-dispatch tmp-1 '(any any))))
+ (if tmp
+ (apply (lambda (x y)
+ (let ((tmp y))
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote")
any))))
+ (if tmp-1
+ (apply (lambda (dy)
+ (let ((tmp x))
+ (let ((tmp ($sc-dispatch tmp
'(#(atom "quote") any))))
+ (if tmp
+ (apply (lambda (dx) (list
"quote" (cons dx dy))) tmp)
+ (if (null? dy) (list "list" x)
(list "list*" x y))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom
"list") . any))))
+ (if tmp-1
+ (apply (lambda (stuff) (cons "list" (cons
x stuff))) tmp-1)
+ (let ((tmp ($sc-dispatch tmp '(#(atom
"list*") . any))))
+ (if tmp
+ (apply (lambda (stuff) (cons "list*"
(cons x stuff))) tmp)
+ (list "list*" x y)))))))))
+ tmp)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-26068))))))
- (quasiappend-25795
- (lambda (x-26103 y-26104)
- (let ((tmp-26106
- ($sc-dispatch y-26104 '(#(atom "quote") ()))))
- (if tmp-26106
- (@apply
- (lambda ()
- (if (null? x-26103)
- '(#(syntax-object
- "quote"
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25636" "l-*-25637"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- ())
- (if (null? (cdr x-26103))
- (car x-26103)
- (let ((tmp-26109 ($sc-dispatch x-26103 'each-any)))
- (if tmp-26109
- (@apply
- (lambda (p-26113)
- (cons '#(syntax-object
- "append"
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p)
- #((top))
- #("l-*-25644"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25636" "l-*-25637"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- p-26113))
- tmp-26109)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26103))))))
- tmp-26106)
- (if (null? x-26103)
- y-26104
- (let ((tmp-26120 (list x-26103 y-26104)))
- (let ((tmp-26121
- ($sc-dispatch tmp-26120 '(each-any any))))
- (if tmp-26121
- (@apply
- (lambda (p-26123 y-26124)
- (cons '#(syntax-object
- "append"
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p y)
- #((top) (top))
- #("l-*-25651" "l-*-25652"))
- #(ribcage () () ())
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25636" "l-*-25637"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- (append p-26123 (list y-26124))))
- tmp-26121)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-26120)))))))))
- (quasilist*-25796
- (lambda (x-26126 y-26127)
- (letrec*
- ((f-26128
- (lambda (x-26217)
- (if (null? x-26217)
- y-26127
- (quasicons-25794
- (car x-26217)
- (f-26128 (cdr x-26217)))))))
- (f-26128 x-26126))))
- (emit-25798
- (lambda (x-26220)
- (let ((tmp-26222
- ($sc-dispatch x-26220 '(#(atom "quote") any))))
- (if tmp-26222
- (@apply
- (lambda (x-26226)
- (list '#(syntax-object
- quote
- ((top)
- #(ribcage #(x) #((top)) #("l-*-25716"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top) (top) (top) (top) (top) (top) (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- x-26226))
- tmp-26222)
- (let ((tmp-26227
- ($sc-dispatch
- x-26220
- '(#(atom "list") . each-any))))
- (if tmp-26227
- (@apply
- (lambda (x-26231)
- (let ((tmp-26232 (map emit-25798 x-26231)))
- (let ((tmp-26233 ($sc-dispatch tmp-26232 'each-any)))
- (if tmp-26233
- (@apply
- (lambda (t-25721-26235)
- (cons '#(syntax-object
- list
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(t-25721)
- #((m-*-25722 top))
- #("l-*-25726"))
- #(ribcage
- #(x)
- #((top))
- #("l-*-25719"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- t-25721-26235))
- tmp-26233)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-26232)))))
- tmp-26227)
- (let ((tmp-26236
- ($sc-dispatch
- x-26220
- '(#(atom "list*") . #(each+ any (any) ())))))
- (if tmp-26236
- (@apply
- (lambda (x-26240 y-26241)
- (letrec*
- ((f-26242
- (lambda (x*-26245)
- (if (null? x*-26245)
- (emit-25798 y-26241)
- (let ((tmp-26246
- (list (emit-25798 (car x*-26245))
- (f-26242 (cdr x*-26245)))))
- (let ((tmp-26247
- ($sc-dispatch
- tmp-26246
- '(any any))))
- (if tmp-26247
- (@apply
- (lambda (t-25741-26249
- t-25740-26250)
- (list '#(syntax-object
- cons
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(t-25741 t-25740)
- #((m-*-25742 top)
- (m-*-25742 top))
- #("l-*-25746"
- "l-*-25747"))
- #(ribcage () () ())
- #(ribcage
- #(f x*)
- #((top) (top))
- #("l-*-25735"
- "l-*-25736"))
- #(ribcage
- #(x y)
- #((top) (top))
- #("l-*-25731"
- "l-*-25732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- t-25741-26249
- t-25740-26250))
- tmp-26247)
- (syntax-violation
- #f
- "source expression failed to match
any pattern"
- tmp-26246))))))))
- (f-26242 x-26240)))
- tmp-26236)
- (let ((tmp-26251
- ($sc-dispatch
- x-26220
- '(#(atom "append") . each-any))))
- (if tmp-26251
- (@apply
- (lambda (x-26255)
- (let ((tmp-26256 (map emit-25798 x-26255)))
- (let ((tmp-26257
- ($sc-dispatch tmp-26256 'each-any)))
- (if tmp-26257
- (@apply
- (lambda (t-25753-26259)
- (cons '#(syntax-object
- append
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(t-25753)
- #((m-*-25754 top))
- #("l-*-25758"))
- #(ribcage
- #(x)
- #((top))
- #("l-*-25751"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- t-25753-26259))
- tmp-26257)
- (syntax-violation
- #f
- "source expression failed to match any
pattern"
- tmp-26256)))))
- tmp-26251)
- (let ((tmp-26260
- ($sc-dispatch
- x-26220
- '(#(atom "vector") . each-any))))
- (if tmp-26260
- (@apply
- (lambda (x-26264)
- (let ((tmp-26265 (map emit-25798 x-26264)))
- (let ((tmp-26266
- ($sc-dispatch
- tmp-26265
- 'each-any)))
- (if tmp-26266
- (@apply
- (lambda (t-25765-26268)
- (cons '#(syntax-object
- vector
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(t-25765)
- #((m-*-25766 top))
- #("l-*-25770"))
- #(ribcage
- #(x)
- #((top))
- #("l-*-25763"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- t-25765-26268))
- tmp-26266)
- (syntax-violation
- #f
- "source expression failed to match
any pattern"
- tmp-26265)))))
- tmp-26260)
- (let ((tmp-26269
- ($sc-dispatch
- x-26220
- '(#(atom "list->vector") any))))
- (if tmp-26269
- (@apply
- (lambda (x-26273)
- (let ((tmp-26274 (emit-25798 x-26273)))
- (list '#(syntax-object
- list->vector
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(t-25777)
- #((m-*-25778 top))
- #("l-*-25781"))
- #(ribcage
- #(x)
- #((top))
- #("l-*-25775"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-25713"))
- #(ribcage
- (emit quasivector
- quasilist*
- quasiappend
- quasicons
- vquasi
- quasi)
- ((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- ("l-*-25552"
- "l-*-25550"
- "l-*-25548"
- "l-*-25546"
- "l-*-25544"
- "l-*-25542"
- "l-*-25540")))
- (hygiene guile))
- tmp-26274)))
- tmp-26269)
- (let ((tmp-26277
- ($sc-dispatch
- x-26220
- '(#(atom "value") any))))
- (if tmp-26277
- (@apply
- (lambda (x-26281) x-26281)
- tmp-26277)
- (syntax-violation
- #f
- "source expression failed to match
any pattern"
- x-26220))))))))))))))))))
- (lambda (x-25799)
- (let ((tmp-25801 ($sc-dispatch x-25799 '(_ any))))
- (if tmp-25801
- (@apply
- (lambda (e-25805)
- (emit-25798 (quasi-25792 e-25805 0)))
- tmp-25801)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-25799)))))))
+ tmp-1))))))
+ (quasiappend
+ (lambda (x y)
+ (let ((tmp y))
+ (let ((tmp ($sc-dispatch tmp '(#(atom "quote") ()))))
+ (if tmp
+ (apply (lambda ()
+ (if (null? x)
+ '("quote" ())
+ (if (null? (cdr x))
+ (car x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 'each-any)))
+ (if tmp
+ (apply (lambda (p) (cons "append" p)) tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1)))))))
+ tmp)
+ (if (null? x)
+ y
+ (let ((tmp-1 (list x y)))
+ (let ((tmp ($sc-dispatch tmp-1 '(each-any any))))
+ (if tmp
+ (apply (lambda (p y) (cons "append" (append p (list
y)))) tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1))))))))))
+ (quasilist*
+ (lambda (x y)
+ (let f ((x x)) (if (null? x) y (quasicons (car x) (f (cdr x)))))))
+ (quasivector
+ (lambda (x)
+ (let ((tmp x))
+ (let ((tmp ($sc-dispatch tmp '(#(atom "quote") each-any))))
+ (if tmp
+ (apply (lambda (x) (list "quote" (list->vector x))) tmp)
+ (let f ((y x)
+ (k (lambda (ls)
+ (let ((tmp-1 ls))
+ (let ((tmp ($sc-dispatch tmp-1 'each-any)))
+ (if tmp
+ (apply (lambda (t) (cons "vector" t)) tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1)))))))
+ (let ((tmp y))
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote")
each-any))))
+ (if tmp-1
+ (apply (lambda (y) (k (map (lambda (tmp) (list
"quote" tmp)) y)))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") .
each-any))))
+ (if tmp-1
+ (apply (lambda (y) (k y)) tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list*")
. #(each+ any (any) ())))))
+ (if tmp-1
+ (apply (lambda (y z) (f z (lambda (ls) (k
(append y ls))))) tmp-1)
+ (let ((else tmp))
+ (let ((tmp x)) (let ((t tmp)) (list
"list->vector" t)))))))))))))))))
+ (emit (lambda (x)
+ (let ((tmp x))
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "quote") any))))
+ (if tmp-1
+ (apply (lambda (x) (list '#(syntax-object quote ((top))
(hygiene guile)) x))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list") .
each-any))))
+ (if tmp-1
+ (apply (lambda (x)
+ (let ((tmp-1 (map emit x)))
+ (let ((tmp ($sc-dispatch tmp-1 'each-any)))
+ (if tmp
+ (apply (lambda (t) (cons
'#(syntax-object list ((top)) (hygiene guile)) t))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match
any pattern"
+ tmp-1)))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "list*") .
#(each+ any (any) ())))))
+ (if tmp-1
+ (apply (lambda (x y)
+ (let f ((x* x))
+ (if (null? x*)
+ (emit y)
+ (let ((tmp-1 (list (emit (car x*))
(f (cdr x*)))))
+ (let ((tmp ($sc-dispatch tmp-1
'(any any))))
+ (if tmp
+ (apply (lambda (t-1 t)
+ (list
'#(syntax-object cons ((top)) (hygiene guile)) t-1 t))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to
match any pattern"
+ tmp-1)))))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom "append")
. each-any))))
+ (if tmp-1
+ (apply (lambda (x)
+ (let ((tmp-1 (map emit x)))
+ (let ((tmp ($sc-dispatch tmp-1
'each-any)))
+ (if tmp
+ (apply (lambda (t)
+ (cons
'#(syntax-object append ((top)) (hygiene guile)) t))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to
match any pattern"
+ tmp-1)))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom
"vector") . each-any))))
+ (if tmp-1
+ (apply (lambda (x)
+ (let ((tmp-1 (map emit x)))
+ (let ((tmp ($sc-dispatch tmp-1
'each-any)))
+ (if tmp
+ (apply (lambda (t)
+ (cons
'#(syntax-object vector ((top)) (hygiene guile)) t))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression
failed to match any pattern"
+ tmp-1)))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp '(#(atom
"list->vector") any))))
+ (if tmp-1
+ (apply (lambda (x)
+ (let ((tmp (emit x)))
+ (let ((t tmp))
+ (list '#(syntax-object
list->vector ((top)) (hygiene guile)) t))))
+ tmp-1)
+ (let ((tmp-1 ($sc-dispatch tmp
'(#(atom "value") any))))
+ (if tmp-1
+ (apply (lambda (x) x) tmp-1)
+ (syntax-violation
+ #f
+ "source expression failed to
match any pattern"
+ tmp)))))))))))))))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ any))))
+ (if tmp
+ (apply (lambda (e) (emit (quasi e 0))) tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1))))))))
(define include
(make-syntax-transformer
'include
'macro
- (lambda (x-26336)
+ (lambda (x)
(letrec*
- ((read-file-26337
- (lambda (fn-26446 k-26447)
- (let ((p-26448 (open-input-file fn-26446)))
- (letrec*
- ((f-26449
- (lambda (x-26503 result-26504)
- (if (eof-object? x-26503)
- (begin
- (close-input-port p-26448)
- (reverse result-26504))
- (f-26449
- (read p-26448)
- (cons (datum->syntax k-26447 x-26503)
- result-26504))))))
- (f-26449 (read p-26448) '()))))))
- (let ((tmp-26339 ($sc-dispatch x-26336 '(any any))))
- (if tmp-26339
- (@apply
- (lambda (k-26343 filename-26344)
- (let ((fn-26345 (syntax->datum filename-26344)))
- (let ((tmp-26346
- (read-file-26337 fn-26345 filename-26344)))
- (let ((tmp-26347 ($sc-dispatch tmp-26346 'each-any)))
- (if tmp-26347
- (@apply
- (lambda (exp-26365)
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage () () ())
- #(ribcage #(exp) #((top)) #("l-*-26333"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-26328"))
- #(ribcage
- #(k filename)
- #((top) (top))
- #("l-*-26324" "l-*-26325"))
- #(ribcage
- (read-file)
- ((top))
- ("l-*-26308"))
- #(ribcage #(x) #((top)) #("l-*-26307")))
- (hygiene guile))
- exp-26365))
- tmp-26347)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- tmp-26346))))))
- tmp-26339)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26336)))))))
+ ((read-file
+ (lambda (fn k)
+ (let ((p (open-input-file fn)))
+ (let f ((x (read p)) (result '()))
+ (if (eof-object? x)
+ (begin (close-input-port p) (reverse result))
+ (f (read p) (cons (datum->syntax k x) result))))))))
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(any any))))
+ (if tmp
+ (apply (lambda (k filename)
+ (let ((fn (syntax->datum filename)))
+ (let ((tmp-1 (read-file fn filename)))
+ (let ((tmp ($sc-dispatch tmp-1 'each-any)))
+ (if tmp
+ (apply (lambda (exp)
+ (cons '#(syntax-object begin ((top))
(hygiene guile)) exp))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any
pattern"
+ tmp-1))))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1))))))))
(define include-from-path
(make-syntax-transformer
'include-from-path
'macro
- (lambda (x-26523)
- (let ((tmp-26525 ($sc-dispatch x-26523 '(any any))))
- (if tmp-26525
- (@apply
- (lambda (k-26529 filename-26530)
- (let ((fn-26531 (syntax->datum filename-26530)))
- (let ((tmp-26532
- (datum->syntax
- filename-26530
- (let ((t-26535 (%search-load-path fn-26531)))
- (if t-26535
- t-26535
- (syntax-violation
- 'include-from-path
- "file not found in path"
- x-26523
- filename-26530))))))
- (list '#(syntax-object
- include
- ((top)
- #(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-26517"))
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-26513"))
- #(ribcage
- #(k filename)
- #((top) (top))
- #("l-*-26509" "l-*-26510"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26506")))
- (hygiene guile))
- tmp-26532))))
- tmp-26525)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26523))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(any any))))
+ (if tmp
+ (apply (lambda (k filename)
+ (let ((fn (syntax->datum filename)))
+ (let ((tmp (datum->syntax
+ filename
+ (let ((t (%search-load-path fn)))
+ (if t
+ t
+ (syntax-violation
+ 'include-from-path
+ "file not found in path"
+ x
+ filename))))))
+ (let ((fn tmp))
+ (list '#(syntax-object include ((top)) (hygiene
guile)) fn)))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))
(define unquote
(make-syntax-transformer
'unquote
'macro
- (lambda (x-26544)
+ (lambda (x)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- x-26544))))
+ x))))
(define unquote-splicing
(make-syntax-transformer
'unquote-splicing
'macro
- (lambda (x-26547)
+ (lambda (x)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- x-26547))))
+ x))))
(define case
(make-syntax-transformer
'case
'macro
- (lambda (x-26599)
- (let ((tmp-26601
- ($sc-dispatch x-26599 '(_ any any . each-any))))
- (if tmp-26601
- (@apply
- (lambda (e-26605 m1-26606 m2-26607)
- (let ((tmp-26608
- (letrec*
- ((f-26652
- (lambda (clause-26655 clauses-26656)
- (if (null? clauses-26656)
- (let ((tmp-26658
- ($sc-dispatch
- clause-26655
- '(#(free-id
- #(syntax-object
- else
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile)))
- any
- .
- each-any))))
- (if tmp-26658
- (@apply
- (lambda (e1-26662 e2-26663)
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage
- #(e1 e2)
- #((top) (top))
- #("l-*-26571" "l-*-26572"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (cons e1-26662 e2-26663)))
- tmp-26658)
- (let ((tmp-26664
- ($sc-dispatch
- clause-26655
- '(each-any any . each-any))))
- (if tmp-26664
- (@apply
- (lambda (k-26668 e1-26669 e2-26670)
- (list '#(syntax-object
- if
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top) (top) (top))
- #("l-*-26577"
- "l-*-26578"
- "l-*-26579"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (list '#(syntax-object
- memv
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top)
- (top)
- (top))
- #("l-*-26577"
- "l-*-26578"
- "l-*-26579"))
- #(ribcage () () ())
- #(ribcage
- #(f
- clause
- clauses)
- #((top)
- (top)
- (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top)
- (top)
- (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- '#(syntax-object
- t
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top)
- (top)
- (top))
- #("l-*-26577"
- "l-*-26578"
- "l-*-26579"))
- #(ribcage () () ())
- #(ribcage
- #(f
- clause
- clauses)
- #((top)
- (top)
- (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top)
- (top)
- (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (list '#(syntax-object
- quote
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top)
- (top)
- (top))
-
#("l-*-26577"
-
"l-*-26578"
-
"l-*-26579"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(f
- clause
- clauses)
- #((top)
- (top)
- (top))
-
#("l-*-26562"
-
"l-*-26563"
-
"l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top)
- (top)
- (top))
-
#("l-*-26552"
-
"l-*-26553"
-
"l-*-26554"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-26549")))
- (hygiene
- guile))
- k-26668))
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top)
- (top)
- (top))
- #("l-*-26577"
- "l-*-26578"
- "l-*-26579"))
- #(ribcage () () ())
- #(ribcage
- #(f
- clause
- clauses)
- #((top)
- (top)
- (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top)
- (top)
- (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (cons e1-26669
- e2-26670))))
- tmp-26664)
- (syntax-violation
- 'case
- "bad clause"
- x-26599
- clause-26655)))))
- (let ((tmp-26677
- (f-26652
- (car clauses-26656)
- (cdr clauses-26656))))
- (let ((tmp-26680
- ($sc-dispatch
- clause-26655
- '(each-any any . each-any))))
- (if tmp-26680
- (@apply
- (lambda (k-26682 e1-26683 e2-26684)
- (list '#(syntax-object
- if
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top) (top) (top))
- #("l-*-26591"
- "l-*-26592"
- "l-*-26593"))
- #(ribcage () () ())
- #(ribcage
- #(rest)
- #((top))
- #("l-*-26587"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (list '#(syntax-object
- memv
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top) (top) (top))
- #("l-*-26591"
- "l-*-26592"
- "l-*-26593"))
- #(ribcage () () ())
- #(ribcage
- #(rest)
- #((top))
- #("l-*-26587"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- '#(syntax-object
- t
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top) (top) (top))
- #("l-*-26591"
- "l-*-26592"
- "l-*-26593"))
- #(ribcage () () ())
- #(ribcage
- #(rest)
- #((top))
- #("l-*-26587"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (list '#(syntax-object
- quote
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top)
- (top)
- (top))
- #("l-*-26591"
- "l-*-26592"
-
"l-*-26593"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(rest)
- #((top))
-
#("l-*-26587"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(f
- clause
- clauses)
- #((top)
- (top)
- (top))
- #("l-*-26562"
- "l-*-26563"
-
"l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top)
- (top)
- (top))
- #("l-*-26552"
- "l-*-26553"
-
"l-*-26554"))
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
-
#("l-*-26549")))
- (hygiene guile))
- k-26682))
- (cons '#(syntax-object
- begin
- ((top)
- #(ribcage
- #(k e1 e2)
- #((top) (top) (top))
- #("l-*-26591"
- "l-*-26592"
- "l-*-26593"))
- #(ribcage () () ())
- #(ribcage
- #(rest)
- #((top))
- #("l-*-26587"))
- #(ribcage () () ())
- #(ribcage
- #(f clause clauses)
- #((top) (top) (top))
- #("l-*-26562"
- "l-*-26563"
- "l-*-26564"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- (cons e1-26683 e2-26684))
- tmp-26677))
- tmp-26680)
- (syntax-violation
- 'case
- "bad clause"
- x-26599
- clause-26655))))))))
- (f-26652 m1-26606 m2-26607))))
- (let ((body-26609 tmp-26608))
- (list '#(syntax-object
- let
- ((top)
- #(ribcage () () ())
- #(ribcage #(body) #((top)) #("l-*-26560"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552" "l-*-26553" "l-*-26554"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26549")))
- (hygiene guile))
- (list (list '#(syntax-object
- t
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(body)
- #((top))
- #("l-*-26560"))
- #(ribcage
- #(e m1 m2)
- #((top) (top) (top))
- #("l-*-26552"
- "l-*-26553"
- "l-*-26554"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26549")))
- (hygiene guile))
- e-26605))
- body-26609))))
- tmp-26601)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26599))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ any any . each-any))))
+ (if tmp
+ (apply (lambda (e m1 m2)
+ (let ((tmp (let f ((clause m1) (clauses m2))
+ (if (null? clauses)
+ (let ((tmp-1 clause))
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(#(free-id #(syntax-object
else ((top)) (hygiene guile)))
+ any
+ .
+ each-any))))
+ (if tmp
+ (apply (lambda (e1 e2)
+ (cons '#(syntax-object
begin ((top)) (hygiene guile)) (cons e1 e2)))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1
'(each-any any . each-any))))
+ (if tmp
+ (apply (lambda (k e1 e2)
+ (list '#(syntax-object
if ((top)) (hygiene guile))
+ (list
'#(syntax-object memv ((top)) (hygiene guile))
+
'#(syntax-object t ((top)) (hygiene guile))
+ (list
'#(syntax-object quote ((top)) (hygiene guile))
+ k))
+ (cons
'#(syntax-object begin ((top)) (hygiene guile))
+ (cons e1
e2))))
+ tmp)
+ (syntax-violation 'case "bad
clause" x clause))))))
+ (let ((tmp (f (car clauses) (cdr
clauses))))
+ (let ((rest tmp))
+ (let ((tmp clause))
+ (let ((tmp ($sc-dispatch tmp
'(each-any any . each-any))))
+ (if tmp
+ (apply (lambda (k e1 e2)
+ (list '#(syntax-object
if ((top)) (hygiene guile))
+ (list
'#(syntax-object memv ((top)) (hygiene guile))
+
'#(syntax-object t ((top)) (hygiene guile))
+ (list
'#(syntax-object quote ((top)) (hygiene guile))
+ k))
+ (cons
'#(syntax-object begin ((top)) (hygiene guile))
+ (cons e1
e2))
+ rest))
+ tmp)
+ (syntax-violation 'case "bad
clause" x clause))))))))))
+ (let ((body tmp))
+ (list '#(syntax-object let ((top)) (hygiene guile))
+ (list (list '#(syntax-object t ((top)) (hygiene
guile)) e))
+ body))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))
(define make-variable-transformer
- (lambda (proc-26699)
- (if (procedure? proc-26699)
- (letrec*
- ((trans-26700
- (lambda (x-26706) (proc-26699 x-26706))))
- (begin
- (set-procedure-property!
- trans-26700
- 'variable-transformer
- #t)
- trans-26700))
- (error "variable transformer not a procedure"
- proc-26699))))
+ (lambda (proc)
+ (if (procedure? proc)
+ (let ((trans (lambda (x) (proc x))))
+ (set-procedure-property! trans 'variable-transformer #t)
+ trans)
+ (error "variable transformer not a procedure" proc))))
(define identifier-syntax
(make-syntax-transformer
'identifier-syntax
'macro
- (lambda (x-26738)
- (let ((tmp-26740 ($sc-dispatch x-26738 '(_ any))))
- (if tmp-26740
- (@apply
- (lambda (e-26744)
- (list '#(syntax-object
- lambda
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- '(#(syntax-object
- x
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile)))
- '#((#(syntax-object
- macro-type
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- .
- #(syntax-object
- identifier-syntax
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))))
- (list '#(syntax-object
- syntax-case
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- '#(syntax-object
- x
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- '()
- (list '#(syntax-object
- id
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- '(#(syntax-object
- identifier?
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- (#(syntax-object
- syntax
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- id
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))))
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(e)
- #((top))
- #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- e-26744))
- (list '(#(syntax-object
- _
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- x
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- ...
- ((top)
- #(ribcage #(e) #((top)) #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile)))
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(e)
- #((top))
- #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- (cons e-26744
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(e)
- #((top))
- #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- ...
- ((top)
- #(ribcage
- #(e)
- #((top))
- #("l-*-26713"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile)))))))))
- tmp-26740)
- (let ((tmp-26745
- ($sc-dispatch
- x-26738
- '(_ (any any)
- ((#(free-id
- #(syntax-object
- set!
- ((top)
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile)))
- any
- any)
- any)))))
- (if (if tmp-26745
- (@apply
- (lambda (id-26749
- exp1-26750
- var-26751
- val-26752
- exp2-26753)
- (if (identifier? id-26749)
- (identifier? var-26751)
- #f))
- tmp-26745)
- #f)
- (@apply
- (lambda (id-26754
- exp1-26755
- var-26756
- val-26757
- exp2-26758)
- (list '#(syntax-object
- make-variable-transformer
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- (list '#(syntax-object
- lambda
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile)))
- '#((#(syntax-object
- macro-type
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))
- .
- #(syntax-object
- variable-transformer
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26710")))
- (hygiene guile))))
- (list '#(syntax-object
- syntax-case
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- '#(syntax-object
- x
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- '(#(syntax-object
- set!
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top) (top) (top) (top) (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile)))
- (list (list '#(syntax-object
- set!
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- var-26756
- val-26757)
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- exp2-26758))
- (list (cons id-26754
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- ...
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))))
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- (cons exp1-26755
- '(#(syntax-object
- x
- ((top)
- #(ribcage
- #(id
- exp1
- var
- val
- exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- #(syntax-object
- ...
- ((top)
- #(ribcage
- #(id
- exp1
- var
- val
- exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))))))
- (list id-26754
- (list '#(syntax-object
- identifier?
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(id
- exp1
- var
- val
- exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- id-26754))
- (list '#(syntax-object
- syntax
- ((top)
- #(ribcage
- #(id exp1 var val exp2)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-26728"
- "l-*-26729"
- "l-*-26730"
- "l-*-26731"
- "l-*-26732"))
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-26710")))
- (hygiene guile))
- exp1-26755))))))
- tmp-26745)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26738))))))))
+ (lambda (xx)
+ (let ((tmp-1 xx))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ any))))
+ (if tmp
+ (apply (lambda (e)
+ (list '#(syntax-object lambda ((top)) (hygiene guile))
+ '(#(syntax-object x ((top)) (hygiene guile)))
+ '#((#(syntax-object macro-type ((top)) (hygiene
guile))
+ .
+ #(syntax-object identifier-syntax ((top))
(hygiene guile))))
+ (list '#(syntax-object syntax-case ((top)) (hygiene
guile))
+ '#(syntax-object x ((top)) (hygiene guile))
+ '()
+ (list '#(syntax-object id ((top)) (hygiene
guile))
+ '(#(syntax-object identifier? ((top))
(hygiene guile))
+ (#(syntax-object syntax ((top))
(hygiene guile))
+ #(syntax-object id ((top)) (hygiene
guile))))
+ (list '#(syntax-object syntax ((top))
(hygiene guile)) e))
+ (list '(#(syntax-object _ ((top)) (hygiene
guile))
+ #(syntax-object x ((top)) (hygiene
guile))
+ #(syntax-object ... ((top)) (hygiene
guile)))
+ (list '#(syntax-object syntax ((top))
(hygiene guile))
+ (cons e
+ '(#(syntax-object x ((top))
(hygiene guile))
+ #(syntax-object ...
((top)) (hygiene guile)))))))))
+ tmp)
+ (let ((tmp ($sc-dispatch
+ tmp-1
+ '(_ (any any)
+ ((#(free-id #(syntax-object set! ((top)) (hygiene
guile))) any any)
+ any)))))
+ (if (if tmp
+ (apply (lambda (id exp1 var val exp2)
+ (if (identifier? id) (identifier? var) #f))
+ tmp)
+ #f)
+ (apply (lambda (id exp1 var val exp2)
+ (list '#(syntax-object make-variable-transformer
((top)) (hygiene guile))
+ (list '#(syntax-object lambda ((top)) (hygiene
guile))
+ '(#(syntax-object x ((top)) (hygiene
guile)))
+ '#((#(syntax-object macro-type ((top))
(hygiene guile))
+ .
+ #(syntax-object variable-transformer
((top)) (hygiene guile))))
+ (list '#(syntax-object syntax-case
((top)) (hygiene guile))
+ '#(syntax-object x ((top)) (hygiene
guile))
+ '(#(syntax-object set! ((top))
(hygiene guile)))
+ (list (list '#(syntax-object set!
((top)) (hygiene guile)) var val)
+ (list '#(syntax-object syntax
((top)) (hygiene guile)) exp2))
+ (list (cons id
+ '(#(syntax-object x
((top)) (hygiene guile))
+ #(syntax-object ...
((top)) (hygiene guile))))
+ (list '#(syntax-object syntax
((top)) (hygiene guile))
+ (cons exp1
+ '(#(syntax-object
x ((top)) (hygiene guile))
+ #(syntax-object
... ((top)) (hygiene guile))))))
+ (list id
+ (list '#(syntax-object
identifier? ((top)) (hygiene guile))
+ (list '#(syntax-object
syntax ((top)) (hygiene guile)) id))
+ (list '#(syntax-object syntax
((top)) (hygiene guile)) exp1))))))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))))
(define define*
(make-syntax-transformer
'define*
'macro
- (lambda (x-26790)
- (let ((tmp-26792
- ($sc-dispatch
- x-26790
- '(_ (any . any) any . each-any))))
- (if tmp-26792
- (@apply
- (lambda (id-26796 args-26797 b0-26798 b1-26799)
- (list '#(syntax-object
- define
- ((top)
- #(ribcage
- #(id args b0 b1)
- #((top) (top) (top) (top))
- #("l-*-26772"
- "l-*-26773"
- "l-*-26774"
- "l-*-26775"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26769")))
- (hygiene guile))
- id-26796
- (cons '#(syntax-object
- lambda*
- ((top)
- #(ribcage
- #(id args b0 b1)
- #((top) (top) (top) (top))
- #("l-*-26772"
- "l-*-26773"
- "l-*-26774"
- "l-*-26775"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26769")))
- (hygiene guile))
- (cons args-26797 (cons b0-26798 b1-26799)))))
- tmp-26792)
- (let ((tmp-26800 ($sc-dispatch x-26790 '(_ any any))))
- (if (if tmp-26800
- (@apply
- (lambda (id-26804 val-26805)
- (identifier? id-26804))
- tmp-26800)
- #f)
- (@apply
- (lambda (id-26806 val-26807)
- (list '#(syntax-object
- define
- ((top)
- #(ribcage
- #(id val)
- #((top) (top))
- #("l-*-26786" "l-*-26787"))
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-26769")))
- (hygiene guile))
- id-26806
- val-26807))
- tmp-26800)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- x-26790))))))))
+ (lambda (x)
+ (let ((tmp-1 x))
+ (let ((tmp ($sc-dispatch tmp-1 '(_ (any . any) any . each-any))))
+ (if tmp
+ (apply (lambda (id args b0 b1)
+ (list '#(syntax-object define ((top)) (hygiene guile))
+ id
+ (cons '#(syntax-object lambda* ((top)) (hygiene
guile))
+ (cons args (cons b0 b1)))))
+ tmp)
+ (let ((tmp ($sc-dispatch tmp-1 '(_ any any))))
+ (if (if tmp (apply (lambda (id val) (identifier? id)) tmp) #f)
+ (apply (lambda (id val)
+ (list '#(syntax-object define ((top)) (hygiene
guile)) id val))
+ tmp)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-1)))))))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7f2f3e3..a25bbba 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -2775,8 +2775,8 @@
((out ...) (let () e1 e2 ...)))))))
(define-syntax syntax-rules
- (lambda (x)
- (syntax-case x ()
+ (lambda (xx)
+ (syntax-case xx ()
((_ (k ...) ((keyword . pattern) template) ...)
#'(lambda (x)
;; embed patterns as procedure metadata
@@ -3027,8 +3027,8 @@
(error "variable transformer not a procedure" proc)))
(define-syntax identifier-syntax
- (lambda (x)
- (syntax-case x (set!)
+ (lambda (xx)
+ (syntax-case xx (set!)
((_ e)
#'(lambda (x)
#((macro-type . identifier-syntax))
diff --git a/module/language/scheme/decompile-tree-il.scm
b/module/language/scheme/decompile-tree-il.scm
index 9243f4e..9191b2f 100644
--- a/module/language/scheme/decompile-tree-il.scm
+++ b/module/language/scheme/decompile-tree-il.scm
@@ -1,6 +1,6 @@
;;; Guile VM code converters
-;; Copyright (C) 2001,2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2012 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -20,7 +20,796 @@
(define-module (language scheme decompile-tree-il)
#:use-module (language tree-il)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 vlist)
+ #:use-module (ice-9 match)
+ #:use-module (system base syntax)
#:export (decompile-tree-il))
-(define (decompile-tree-il x env opts)
- (values (tree-il->scheme x) env))
+(define (decompile-tree-il e env opts)
+ (apply do-decompile e env opts))
+
+(define* (do-decompile e env
+ #:key
+ (use-derived-syntax? #t)
+ (avoid-lambda? #t)
+ (use-case? #t)
+ (strip-numeric-suffixes? #f)
+ #:allow-other-keys)
+
+ (receive (output-name-table occurrence-count-table)
+ (choose-output-names e use-derived-syntax? strip-numeric-suffixes?)
+
+ (define (output-name s) (hashq-ref output-name-table s))
+ (define (occurrence-count s) (hashq-ref occurrence-count-table s))
+
+ (define (const x) (lambda (_) x))
+ (define (atom? x) (not (or (pair? x) (vector? x))))
+
+ (define (build-void) '(if #f #f))
+
+ (define (build-begin es)
+ (match es
+ (() (build-void))
+ ((e) e)
+ (_ `(begin ,@es))))
+
+ (define (build-lambda-body e)
+ (match e
+ (('let () body ...) body)
+ (('begin es ...) es)
+ (_ (list e))))
+
+ (define (build-begin-body e)
+ (match e
+ (('begin es ...) es)
+ (_ (list e))))
+
+ (define (build-define name e)
+ (match e
+ ((? (const avoid-lambda?)
+ ('lambda formals body ...))
+ `(define (,name ,@formals) ,@body))
+ ((? (const avoid-lambda?)
+ ('lambda* formals body ...))
+ `(define* (,name ,@formals) ,@body))
+ (_ `(define ,name ,e))))
+
+ (define (build-let names vals body)
+ (match `(let ,(map list names vals)
+ ,@(build-lambda-body body))
+ ((_ () e) e)
+ ((_ (b) ('let* (bs ...) body ...))
+ `(let* (,b ,@bs) ,@body))
+ ((? (const use-derived-syntax?)
+ (_ (b1) ('let (b2) body ...)))
+ `(let* (,b1 ,b2) ,@body))
+ (e e)))
+
+ (define (build-letrec in-order? names vals body)
+ (match `(,(if in-order? 'letrec* 'letrec)
+ ,(map list names vals)
+ ,@(build-lambda-body body))
+ ((_ () e) e)
+ ((_ () body ...) `(let () ,@body))
+ ((_ ((name ('lambda (formals ...) body ...)))
+ (name args ...))
+ (=> failure)
+ (if (= (length formals) (length args))
+ `(let ,name ,(map list formals args) ,@body)
+ (failure)))
+ ((? (const avoid-lambda?)
+ ('letrec* _ body ...))
+ `(let ()
+ ,@(map build-define names vals)
+ ,@body))
+ (e e)))
+
+ (define (build-if test consequent alternate)
+ (match alternate
+ (('if #f _) `(if ,test ,consequent))
+ (_ `(if ,test ,consequent ,alternate))))
+
+ (define (build-and xs)
+ (match xs
+ (() #t)
+ ((x) x)
+ (_ `(and ,@xs))))
+
+ (define (build-or xs)
+ (match xs
+ (() #f)
+ ((x) x)
+ (_ `(or ,@xs))))
+
+ (define (case-test-var test)
+ (match test
+ (('memv (? atom? v) ('quote (datums ...)))
+ v)
+ (('eqv? (? atom? v) ('quote datum))
+ v)
+ (_ #f)))
+
+ (define (test->datums v test)
+ (match (cons v test)
+ ((v 'memv v ('quote (xs ...)))
+ xs)
+ ((v 'eqv? v ('quote x))
+ (list x))
+ (_ #f)))
+
+ (define (build-else-tail e)
+ (match e
+ (('if #f _) '())
+ (('and xs ... x) `((,(build-and xs) ,@(build-begin-body x))
+ (else #f)))
+ (_ `((else ,@(build-begin-body e))))))
+
+ (define (build-cond-else-tail e)
+ (match e
+ (('cond clauses ...) clauses)
+ (_ (build-else-tail e))))
+
+ (define (build-case-else-tail v e)
+ (match (cons v e)
+ ((v 'case v clauses ...)
+ clauses)
+ ((v 'if ('memv v ('quote (xs ...))) consequent . alternate*)
+ `((,xs ,@(build-begin-body consequent))
+ ,@(build-case-else-tail v (build-begin alternate*))))
+ ((v 'if ('eqv? v ('quote x)) consequent . alternate*)
+ `(((,x) ,@(build-begin-body consequent))
+ ,@(build-case-else-tail v (build-begin alternate*))))
+ (_ (build-else-tail e))))
+
+ (define (clauses+tail clauses)
+ (match clauses
+ ((cs ... (and c ('else . _))) (values cs (list c)))
+ (_ (values clauses '()))))
+
+ (define (build-cond tests consequents alternate)
+ (case (length tests)
+ ((0) alternate)
+ ((1) (build-if (car tests) (car consequents) alternate))
+ (else `(cond ,@(map (lambda (test consequent)
+ `(,test ,@(build-begin-body consequent)))
+ tests consequents)
+ ,@(build-cond-else-tail alternate)))))
+
+ (define (build-cond-or-case tests consequents alternate)
+ (if (not use-case?)
+ (build-cond tests consequents alternate)
+ (let* ((v (and (not (null? tests))
+ (case-test-var (car tests))))
+ (datum-lists (take-while identity
+ (map (cut test->datums v <>)
+ tests)))
+ (n (length datum-lists))
+ (tail (build-case-else-tail v (build-cond
+ (drop tests n)
+ (drop consequents n)
+ alternate))))
+ (receive (clauses tail) (clauses+tail tail)
+ (let ((n (+ n (length clauses)))
+ (datum-lists (append datum-lists
+ (map car clauses)))
+ (consequents (append consequents
+ (map build-begin
+ (map cdr clauses)))))
+ (if (< n 2)
+ (build-cond tests consequents alternate)
+ `(case ,v
+ ,@(map cons datum-lists (map build-begin-body
+ (take consequents n)))
+ ,@tail)))))))
+
+ (define (recurse e)
+
+ (define (recurse-body e)
+ (build-lambda-body (recurse e)))
+
+ (record-case e
+ ((<void>)
+ (build-void))
+
+ ((<const> exp)
+ (if (and (self-evaluating? exp) (not (vector? exp)))
+ exp
+ `(quote ,exp)))
+
+ ((<sequence> exps)
+ (build-begin (map recurse exps)))
+
+ ((<application> proc args)
+ (match `(,(recurse proc) ,@(map recurse args))
+ ((('lambda (formals ...) body ...) args ...)
+ (=> failure)
+ (if (= (length formals) (length args))
+ (build-let formals args (build-begin body))
+ (failure)))
+ (e e)))
+
+ ((<primitive-ref> name)
+ name)
+
+ ((<lexical-ref> gensym)
+ (output-name gensym))
+
+ ((<lexical-set> gensym exp)
+ `(set! ,(output-name gensym) ,(recurse exp)))
+
+ ((<module-ref> mod name public?)
+ `(,(if public? '@ '@@) ,mod ,name))
+
+ ((<module-set> mod name public? exp)
+ `(set! (,(if public? '@ '@@) ,mod ,name) ,(recurse exp)))
+
+ ((<toplevel-ref> name)
+ name)
+
+ ((<toplevel-set> name exp)
+ `(set! ,name ,(recurse exp)))
+
+ ((<toplevel-define> name exp)
+ (build-define name (recurse exp)))
+
+ ((<lambda> meta body)
+ (let ((body (recurse body))
+ (doc (assq-ref meta 'documentation)))
+ (if (not doc)
+ body
+ (match body
+ (('lambda formals body ...)
+ `(lambda ,formals ,doc ,@body))
+ (('lambda* formals body ...)
+ `(lambda* ,formals ,doc ,@body))
+ (('case-lambda (formals body ...) clauses ...)
+ `(case-lambda (,formals ,doc ,@body) ,@clauses))
+ (('case-lambda* (formals body ...) clauses ...)
+ `(case-lambda* (,formals ,doc ,@body) ,@clauses))
+ (e e)))))
+
+ ((<lambda-case> req opt rest kw inits gensyms body alternate)
+ (let ((names (map output-name gensyms)))
+ (cond
+ ((and (not opt) (not kw) (not alternate))
+ `(lambda ,(if rest (apply cons* names) names)
+ ,@(recurse-body body)))
+ ((and (not opt) (not kw))
+ (let ((alt-expansion (recurse alternate))
+ (formals (if rest (apply cons* names) names)))
+ (case (car alt-expansion)
+ ((lambda)
+ `(case-lambda (,formals ,@(recurse-body body))
+ ,(cdr alt-expansion)))
+ ((lambda*)
+ `(case-lambda* (,formals ,@(recurse-body body))
+ ,(cdr alt-expansion)))
+ ((case-lambda)
+ `(case-lambda (,formals ,@(recurse-body body))
+ ,@(cdr alt-expansion)))
+ ((case-lambda*)
+ `(case-lambda* (,formals ,@(recurse-body body))
+ ,@(cdr alt-expansion))))))
+ (else
+ (let* ((alt-expansion (and alternate (recurse alternate)))
+ (nreq (length req))
+ (nopt (if opt (length opt) 0))
+ (restargs (if rest (list-ref names (+ nreq nopt)) '()))
+ (reqargs (list-head names nreq))
+ (optargs (if opt
+ `(#:optional
+ ,@(map list
+ (list-head (list-tail names nreq)
nopt)
+ (map recurse
+ (list-head inits nopt))))
+ '()))
+ (kwargs (if kw
+ `(#:key
+ ,@(map list
+ (map output-name (map caddr (cdr kw)))
+ (map recurse
+ (list-tail inits nopt))
+ (map car (cdr kw)))
+ ,@(if (car kw)
+ '(#:allow-other-keys)
+ '()))
+ '()))
+ (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs)))
+ (if (not alt-expansion)
+ `(lambda* ,formals ,@(recurse-body body))
+ (case (car alt-expansion)
+ ((lambda lambda*)
+ `(case-lambda* (,formals ,@(recurse-body body))
+ ,(cdr alt-expansion)))
+ ((case-lambda case-lambda*)
+ `(case-lambda* (,formals ,@(recurse-body body))
+ ,@(cdr alt-expansion))))))))))
+
+ ((<conditional> test consequent alternate)
+ (define (simplify-test e)
+ (match e
+ (('if ('eqv? (? atom? v) ('quote a)) #t ('eqv? v ('quote b)))
+ `(memv ,v '(,a ,b)))
+ (('if ('eqv? (? atom? v) ('quote a)) #t ('memv v ('quote (bs
...))))
+ `(memv ,v '(,a ,@bs)))
+ (('case (? atom? v)
+ ((datum) #t) ...
+ ('else ('eqv? v ('quote last-datum))))
+ `(memv ,v '(,@datum ,last-datum)))
+ (_ e)))
+ (match `(if ,(simplify-test (recurse test))
+ ,(recurse consequent)
+ ,@(if (void? alternate) '()
+ (list (recurse alternate))))
+ (('if test ('if ('and xs ...) consequent))
+ (build-if (build-and (cons test xs))
+ consequent
+ (build-void)))
+ ((? (const use-derived-syntax?)
+ ('if test1 ('if test2 consequent)))
+ (build-if (build-and (list test1 test2))
+ consequent
+ (build-void)))
+ (('if (? atom? x) x ('or ys ...))
+ (build-or (cons x ys)))
+ ((? (const use-derived-syntax?)
+ ('if (? atom? x) x y))
+ (build-or (list x y)))
+ (('if test consequent)
+ `(if ,test ,consequent))
+ (('if test ('and xs ...) #f)
+ (build-and (cons test xs)))
+ ((? (const use-derived-syntax?)
+ ('if test consequent #f))
+ (build-and (list test consequent)))
+ ((? (const use-derived-syntax?)
+ ('if test1 consequent1
+ ('if test2 consequent2 . alternate*)))
+ (build-cond-or-case (list test1 test2)
+ (list consequent1 consequent2)
+ (build-begin alternate*)))
+ (('if test consequent ('cond clauses ...))
+ `(cond (,test ,@(build-begin-body consequent))
+ ,@clauses))
+ (('if ('memv (? atom? v) ('quote (xs ...))) consequent
+ ('case v clauses ...))
+ `(case ,v (,xs ,@(build-begin-body consequent))
+ ,@clauses))
+ (('if ('eqv? (? atom? v) ('quote x)) consequent
+ ('case v clauses ...))
+ `(case ,v ((,x) ,@(build-begin-body consequent))
+ ,@clauses))
+ (e e)))
+
+ ((<let> gensyms vals body)
+ (match (build-let (map output-name gensyms)
+ (map recurse vals)
+ (recurse body))
+ (('let ((v e)) ('or v xs ...))
+ (=> failure)
+ (if (and (not (null? gensyms))
+ (= 3 (occurrence-count (car gensyms))))
+ `(or ,e ,@xs)
+ (failure)))
+ (('let ((v e)) ('case v clauses ...))
+ (=> failure)
+ (if (and (not (null? gensyms))
+ ;; FIXME: This fails if any of the 'memv's were
+ ;; optimized into multiple 'eqv?'s, because the
+ ;; occurrence count will be higher than we expect.
+ (= (occurrence-count (car gensyms))
+ (1+ (length (clauses+tail clauses)))))
+ `(case ,e ,@clauses)
+ (failure)))
+ (e e)))
+
+ ((<letrec> in-order? gensyms vals body)
+ (build-letrec in-order?
+ (map output-name gensyms)
+ (map recurse vals)
+ (recurse body)))
+
+ ((<fix> gensyms vals body)
+ ;; not a typo, we really do translate back to letrec. use letrec*
since it
+ ;; doesn't matter, and the naive letrec* transformation does not
require an
+ ;; inner let.
+ (build-letrec #t
+ (map output-name gensyms)
+ (map recurse vals)
+ (recurse body)))
+
+ ((<let-values> exp body)
+ `(call-with-values (lambda () ,@(recurse-body exp))
+ ,(recurse (make-lambda #f '() body))))
+
+ ((<dynwind> body winder unwinder)
+ `(dynamic-wind ,(recurse winder)
+ (lambda () ,@(recurse-body body))
+ ,(recurse unwinder)))
+
+ ((<dynlet> fluids vals body)
+ `(with-fluids ,(map list
+ (map recurse fluids)
+ (map recurse vals))
+ ,@(recurse-body body)))
+
+ ((<dynref> fluid)
+ `(fluid-ref ,(recurse fluid)))
+
+ ((<dynset> fluid exp)
+ `(fluid-set! ,(recurse fluid) ,(recurse exp)))
+
+ ((<prompt> tag body handler)
+ `(call-with-prompt
+ ,(recurse tag)
+ (lambda () ,@(recurse-body body))
+ ,(recurse handler)))
+
+
+ ((<abort> tag args tail)
+ `(apply abort ,(recurse tag) ,@(map recurse args)
+ ,(recurse tail)))))
+ (values (recurse e) env)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Algorithm for choosing better variable names
+;; ============================================
+;;
+;; First we perform an analysis pass, collecting the following
+;; information:
+;;
+;; * For each gensym: how many occurrences will occur in the output?
+;;
+;; * For each gensym A: which gensyms does A conflict with? Gensym A
+;; and gensym B conflict if they have the same base name (usually the
+;; same as the source name, but see below), and if giving them the
+;; same name would cause a bad variable reference due to unintentional
+;; variable capture.
+;;
+;; The occurrence counter is indexed by gensym and is global (within each
+;; invocation of the algorithm), implemented using a hash table. We also
+;; keep a global mapping from gensym to source name as provided by the
+;; binding construct (we prefer not to trust the source names in the
+;; lexical ref or set).
+;;
+;; As we recurse down into lexical binding forms, we keep track of a
+;; mapping from base name to an ordered list of bindings, innermost
+;; first. When we encounter a variable occurrence, we increment the
+;; counter, look up the base name (preferring not to trust the 'name' in
+;; the lexical ref or set), and then look up the bindings currently in
+;; effect for that base name. Hopefully our gensym will be the first
+;; (innermost) binding. If not, we register a conflict between the
+;; referenced gensym and the other bound gensyms with the same base name
+;; that shadow the binding we want. These are simply the gensyms on the
+;; binding list that come before our gensym.
+;;
+;; Top-level bindings are treated specially. Whenever top-level
+;; references are found, they conflict with every lexical binding
+;; currently in effect with the same base name. They are guaranteed to
+;; be assigned to their source names. For purposes of recording
+;; conflicts (which are normally keyed on gensyms) top-level identifiers
+;; are assigned a pseudo-gensym that is an interned pair of the form
+;; (top-level . <name>). This allows them to be compared using 'eq?'
+;; like other gensyms.
+;;
+;; The base name is normally just the source name. However, if the
+;; source name has a suffix of the form "-N" (where N is a positive
+;; integer without leading zeroes), then we strip that suffix (multiple
+;; times if necessary) to form the base name. We must do this because
+;; we add suffixes of that form in order to resolve conflicts, and we
+;; must ensure that only identifiers with the same base name can
+;; possibly conflict with each other.
+;;
+;; XXX FIXME: Currently, primitives are treated exactly like top-level
+;; bindings. This handles conflicting lexical bindings properly, but
+;; does _not_ handle the case where top-level bindings conflict with the
+;; needed primitives.
+;;
+;; Also note that this requires that 'choose-output-names' be kept in
+;; sync with 'tree-il->scheme'. Primitives that are introduced by
+;; 'tree-il->scheme' must be anticipated by 'choose-output-name'.
+;;
+;; We also ensure that lexically-bound identifiers found in operator
+;; position will never be assigned one of the standard primitive names.
+;; This is needed because 'tree-il->scheme' recognizes primitive names
+;; in operator position and assumes that they have the standard
+;; bindings.
+;;
+;;
+;; How we assign an output name to each gensym
+;; ===========================================
+;;
+;; We process the gensyms in order of decreasing occurrence count, with
+;; each gensym choosing the best output name possible, as long as it
+;; isn't the same name as any of the previously-chosen output names of
+;; conflicting gensyms.
+;;
+
+
+;;
+;; 'choose-output-names' analyzes the top-level form e, chooses good
+;; variable names that are as close as possible to the source names,
+;; and returns two values:
+;;
+;; * a hash table mapping gensym to output name
+;; * a hash table mapping gensym to number of occurrences
+;;
+(define choose-output-names
+ (let ()
+ (define primitive?
+ ;; This is a list of primitives that 'tree-il->scheme' assumes
+ ;; will have the standard bindings when found in operator
+ ;; position.
+ (let* ((primitives '(if quote @ @@ set! define define*
+ begin let let* letrec letrec*
+ and or cond case
+ lambda lambda* case-lambda case-lambda*
+ apply call-with-values dynamic-wind
+ with-fluids fluid-ref fluid-set!
+ call-with-prompt abort memv eqv?))
+ (table (make-hash-table (length primitives))))
+ (for-each (cut hashq-set! table <> #t) primitives)
+ (lambda (name) (hashq-ref table name))))
+
+ ;; Repeatedly strip suffix of the form "-N", where N is a string
+ ;; that could be produced by number->string given a positive
+ ;; integer. In other words, the first digit of N may not be 0.
+ (define compute-base-name
+ (let ((digits (string->char-set "0123456789")))
+ (define (base-name-string str)
+ (let ((i (string-skip-right str digits)))
+ (if (and i (< (1+ i) (string-length str))
+ (eq? #\- (string-ref str i))
+ (not (eq? #\0 (string-ref str (1+ i)))))
+ (base-name-string (substring str 0 i))
+ str)))
+ (lambda (sym)
+ (string->symbol (base-name-string (symbol->string sym))))))
+
+ ;; choose-output-names
+ (lambda (e use-derived-syntax? strip-numeric-suffixes?)
+
+ (define lexical-gensyms '())
+
+ (define top-level-intern!
+ (let ((table (make-hash-table)))
+ (lambda (name)
+ (let ((h (hashq-create-handle! table name #f)))
+ (or (cdr h) (begin (set-cdr! h (cons 'top-level name))
+ (cdr h)))))))
+ (define (top-level? s) (pair? s))
+ (define (top-level-name s) (cdr s))
+
+ (define occurrence-count-table (make-hash-table))
+ (define (occurrence-count s) (or (hashq-ref occurrence-count-table s) 0))
+ (define (increment-occurrence-count! s)
+ (let ((h (hashq-create-handle! occurrence-count-table s 0)))
+ (if (zero? (cdr h))
+ (set! lexical-gensyms (cons s lexical-gensyms)))
+ (set-cdr! h (1+ (cdr h)))))
+
+ (define base-name
+ (let ((table (make-hash-table)))
+ (lambda (name)
+ (let ((h (hashq-create-handle! table name #f)))
+ (or (cdr h) (begin (set-cdr! h (compute-base-name name))
+ (cdr h)))))))
+
+ (define source-name-table (make-hash-table))
+ (define (set-source-name! s name)
+ (if (not (top-level? s))
+ (let ((name (if strip-numeric-suffixes?
+ (base-name name)
+ name)))
+ (hashq-set! source-name-table s name))))
+ (define (source-name s)
+ (if (top-level? s)
+ (top-level-name s)
+ (hashq-ref source-name-table s)))
+
+ (define conflict-table (make-hash-table))
+ (define (conflicts s) (or (hashq-ref conflict-table s) '()))
+ (define (add-conflict! a b)
+ (define (add! a b)
+ (if (not (top-level? a))
+ (let ((h (hashq-create-handle! conflict-table a '())))
+ (if (not (memq b (cdr h)))
+ (set-cdr! h (cons b (cdr h)))))))
+ (add! a b)
+ (add! b a))
+
+ (let recurse-with-bindings ((e e) (bindings vlist-null))
+ (let recurse ((e e))
+
+ ;; We call this whenever we encounter a top-level ref or set
+ (define (top-level name)
+ (let ((bname (base-name name)))
+ (let ((s (top-level-intern! name))
+ (conflicts (vhash-foldq* cons '() bname bindings)))
+ (for-each (cut add-conflict! s <>) conflicts))))
+
+ ;; We call this whenever we encounter a primitive reference.
+ ;; We must also call it for every primitive that might be
+ ;; inserted by 'tree-il->scheme'. It is okay to call this
+ ;; even when 'tree-il->scheme' will not insert the named
+ ;; primitive; the worst that will happen is for a lexical
+ ;; variable of the same name to be renamed unnecessarily.
+ (define (primitive name) (top-level name))
+
+ ;; We call this whenever we encounter a lexical ref or set.
+ (define (lexical s)
+ (increment-occurrence-count! s)
+ (let ((conflicts
+ (take-while
+ (lambda (s*) (not (eq? s s*)))
+ (reverse! (vhash-foldq* cons
+ '()
+ (base-name (source-name s))
+ bindings)))))
+ (for-each (cut add-conflict! s <>) conflicts)))
+
+ (record-case e
+ ((<void>) (primitive 'if)) ; (if #f #f)
+ ((<const>) (primitive 'quote))
+
+ ((<application> proc args)
+ (if (lexical-ref? proc)
+ (let* ((gensym (lexical-ref-gensym proc))
+ (name (source-name gensym)))
+ ;; If the operator position contains a bare variable
+ ;; reference with the same source name as a standard
+ ;; primitive, we must ensure that it will be given a
+ ;; different name, so that 'tree-il->scheme' will not
+ ;; misinterpret the resulting expression.
+ (if (primitive? name)
+ (add-conflict! gensym (top-level-intern! name)))))
+ (recurse proc)
+ (for-each recurse args))
+
+ ((<primitive-ref> name) (primitive name))
+
+ ((<lexical-ref> gensym) (lexical gensym))
+ ((<lexical-set> gensym exp)
+ (primitive 'set!) (lexical gensym) (recurse exp))
+
+ ((<module-ref> public?) (primitive (if public? '@ '@@)))
+ ((<module-set> public? exp)
+ (primitive 'set!) (primitive (if public? '@ '@@)) (recurse exp))
+
+ ((<toplevel-ref> name) (top-level name))
+ ((<toplevel-set> name exp)
+ (primitive 'set!) (top-level name) (recurse exp))
+ ((<toplevel-define> name exp) (top-level name) (recurse exp))
+
+ ((<conditional> test consequent alternate)
+ (cond (use-derived-syntax?
+ (primitive 'and) (primitive 'or)
+ (primitive 'cond) (primitive 'case)
+ (primitive 'else) (primitive '=>)))
+ (primitive 'if)
+ (recurse test) (recurse consequent) (recurse alternate))
+
+ ((<sequence> exps) (primitive 'begin) (for-each recurse exps))
+ ((<lambda> body) (recurse body))
+
+ ((<lambda-case> req opt rest kw inits gensyms body alternate)
+ (primitive 'lambda)
+ (cond ((or opt kw alternate)
+ (primitive 'lambda*)
+ (primitive 'case-lambda)
+ (primitive 'case-lambda*)))
+ (primitive 'let)
+ (if use-derived-syntax? (primitive 'let*))
+ (let* ((names (append req (or opt '()) (if rest (list rest) '())
+ (map cadr (if kw (cdr kw) '()))))
+ (base-names (map base-name names))
+ (body-bindings
+ (fold vhash-consq bindings base-names gensyms)))
+ (for-each increment-occurrence-count! gensyms)
+ (for-each set-source-name! gensyms names)
+ (for-each recurse inits)
+ (recurse-with-bindings body body-bindings)
+ (if alternate (recurse alternate))))
+
+ ((<let> names gensyms vals body)
+ (primitive 'let)
+ (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+ (for-each increment-occurrence-count! gensyms)
+ (for-each set-source-name! gensyms names)
+ (for-each recurse vals)
+ (recurse-with-bindings
+ body (fold vhash-consq bindings (map base-name names) gensyms)))
+
+ ((<letrec> in-order? names gensyms vals body)
+ (primitive 'let)
+ (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+ (primitive (if in-order? 'letrec* 'letrec))
+ (for-each increment-occurrence-count! gensyms)
+ (for-each set-source-name! gensyms names)
+ (let* ((base-names (map base-name names))
+ (bindings (fold vhash-consq bindings base-names gensyms)))
+ (for-each (cut recurse-with-bindings <> bindings) vals)
+ (recurse-with-bindings body bindings)))
+
+ ((<fix> names gensyms vals body)
+ (primitive 'let)
+ (primitive 'letrec*)
+ (cond (use-derived-syntax? (primitive 'let*) (primitive 'or)))
+ (for-each increment-occurrence-count! gensyms)
+ (for-each set-source-name! gensyms names)
+ (let* ((base-names (map base-name names))
+ (bindings (fold vhash-consq bindings base-names gensyms)))
+ (for-each (cut recurse-with-bindings <> bindings) vals)
+ (recurse-with-bindings body bindings)))
+
+ ((<let-values> exp body)
+ (primitive 'call-with-values)
+ (recurse exp) (recurse body))
+
+ ((<dynwind> winder body unwinder)
+ (primitive 'dynamic-wind)
+ (recurse winder) (recurse body) (recurse unwinder))
+
+ ((<dynlet> fluids vals body)
+ (primitive 'with-fluids)
+ (for-each recurse fluids)
+ (for-each recurse vals)
+ (recurse body))
+
+ ((<dynref> fluid) (primitive 'fluid-ref) (recurse fluid))
+ ((<dynset> fluid exp)
+ (primitive 'fluid-set!) (recurse fluid) (recurse exp))
+
+ ((<prompt> tag body handler)
+ (primitive 'call-with-prompt)
+ (primitive 'lambda)
+ (recurse tag) (recurse body) (recurse handler))
+
+ ((<abort> tag args tail)
+ (primitive 'apply)
+ (primitive 'abort)
+ (recurse tag) (for-each recurse args) (recurse tail)))))
+
+ (let ()
+ (define output-name-table (make-hash-table))
+ (define (set-output-name! s name)
+ (hashq-set! output-name-table s name))
+ (define (output-name s)
+ (if (top-level? s)
+ (top-level-name s)
+ (hashq-ref output-name-table s)))
+
+ (define sorted-lexical-gensyms
+ (sort-list lexical-gensyms
+ (lambda (a b) (> (occurrence-count a)
+ (occurrence-count b)))))
+
+ (for-each (lambda (s)
+ (set-output-name!
+ s
+ (let ((the-conflicts (conflicts s))
+ (the-source-name (source-name s)))
+ (define (not-yet-taken? name)
+ (not (any (lambda (s*)
+ (and=> (output-name s*)
+ (cut eq? name <>)))
+ the-conflicts)))
+ (if (not-yet-taken? the-source-name)
+ the-source-name
+ (let ((prefix (string-append
+ (symbol->string the-source-name)
+ "-")))
+ (let loop ((i 1) (name the-source-name))
+ (if (not-yet-taken? name)
+ name
+ (loop (+ i 1)
+ (string->symbol
+ (string-append
+ prefix
+ (number->string i)))))))))))
+ sorted-lexical-gensyms)
+ (values output-name-table occurrence-count-table)))))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 1d391c4..3ee89fb 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -331,155 +331,10 @@
`(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args)
,(unparse-tree-il tail)))))
-(define (tree-il->scheme e)
- (record-case e
- ((<void>)
- '(if #f #f))
-
- ((<application> proc args)
- `(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
-
- ((<conditional> test consequent alternate)
- (if (void? alternate)
- `(if ,(tree-il->scheme test) ,(tree-il->scheme consequent))
- `(if ,(tree-il->scheme test) ,(tree-il->scheme consequent)
,(tree-il->scheme alternate))))
-
- ((<primitive-ref> name)
- name)
-
- ((<lexical-ref> gensym)
- gensym)
-
- ((<lexical-set> gensym exp)
- `(set! ,gensym ,(tree-il->scheme exp)))
-
- ((<module-ref> mod name public?)
- `(,(if public? '@ '@@) ,mod ,name))
-
- ((<module-set> mod name public? exp)
- `(set! (,(if public? '@ '@@) ,mod ,name) ,(tree-il->scheme exp)))
-
- ((<toplevel-ref> name)
- name)
-
- ((<toplevel-set> name exp)
- `(set! ,name ,(tree-il->scheme exp)))
-
- ((<toplevel-define> name exp)
- `(define ,name ,(tree-il->scheme exp)))
-
- ((<lambda> meta body)
- ;; fixme: put in docstring
- (tree-il->scheme body))
-
- ((<lambda-case> req opt rest kw inits gensyms body alternate)
- (cond
- ((and (not opt) (not kw) (not alternate))
- `(lambda ,(if rest (apply cons* gensyms) gensyms)
- ,(tree-il->scheme body)))
- ((and (not opt) (not kw))
- (let ((alt-expansion (tree-il->scheme alternate))
- (formals (if rest (apply cons* gensyms) gensyms)))
- (case (car alt-expansion)
- ((lambda)
- `(case-lambda (,formals ,(tree-il->scheme body))
- ,(cdr alt-expansion)))
- ((lambda*)
- `(case-lambda* (,formals ,(tree-il->scheme body))
- ,(cdr alt-expansion)))
- ((case-lambda)
- `(case-lambda (,formals ,(tree-il->scheme body))
- ,@(cdr alt-expansion)))
- ((case-lambda*)
- `(case-lambda* (,formals ,(tree-il->scheme body))
- ,@(cdr alt-expansion))))))
- (else
- (let* ((alt-expansion (and alternate (tree-il->scheme alternate)))
- (nreq (length req))
- (nopt (if opt (length opt) 0))
- (restargs (if rest (list-ref gensyms (+ nreq nopt)) '()))
- (reqargs (list-head gensyms nreq))
- (optargs (if opt
- `(#:optional
- ,@(map list
- (list-head (list-tail gensyms nreq) nopt)
- (map tree-il->scheme
- (list-head inits nopt))))
- '()))
- (kwargs (if kw
- `(#:key
- ,@(map list
- (map caddr (cdr kw))
- (map tree-il->scheme
- (list-tail inits nopt))
- (map car (cdr kw)))
- ,@(if (car kw)
- '(#:allow-other-keys)
- '()))
- '()))
- (formals `(,@reqargs ,@optargs ,@kwargs . ,restargs)))
- (if (not alt-expansion)
- `(lambda* ,formals ,(tree-il->scheme body))
- (case (car alt-expansion)
- ((lambda lambda*)
- `(case-lambda* (,formals ,(tree-il->scheme body))
- ,(cdr alt-expansion)))
- ((case-lambda case-lambda*)
- `(case-lambda* (,formals ,(tree-il->scheme body))
- ,@(cdr alt-expansion)))))))))
-
- ((<const> exp)
- (if (and (self-evaluating? exp) (not (vector? exp)))
- exp
- (list 'quote exp)))
-
- ((<sequence> exps)
- `(begin ,@(map tree-il->scheme exps)))
-
- ((<let> gensyms vals body)
- `(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme
body)))
-
- ((<letrec> in-order? gensyms vals body)
- `(,(if in-order? 'letrec* 'letrec)
- ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body)))
-
- ((<fix> gensyms vals body)
- ;; not a typo, we really do translate back to letrec. use letrec* since it
- ;; doesn't matter, and the naive letrec* transformation does not require
an
- ;; inner let.
- `(letrec* ,(map list gensyms (map tree-il->scheme vals))
,(tree-il->scheme body)))
-
- ((<let-values> exp body)
- `(call-with-values (lambda () ,(tree-il->scheme exp))
- ,(tree-il->scheme (make-lambda #f '() body))))
-
- ((<dynwind> body winder unwinder)
- `(dynamic-wind ,(tree-il->scheme winder)
- (lambda () ,(tree-il->scheme body))
- ,(tree-il->scheme unwinder)))
-
- ((<dynlet> fluids vals body)
- `(with-fluids ,(map list
- (map tree-il->scheme fluids)
- (map tree-il->scheme vals))
- ,(tree-il->scheme body)))
-
- ((<dynref> fluid)
- `(fluid-ref ,(tree-il->scheme fluid)))
-
- ((<dynset> fluid exp)
- `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp)))
-
- ((<prompt> tag body handler)
- `(call-with-prompt
- ,(tree-il->scheme tag)
- (lambda () ,(tree-il->scheme body))
- ,(tree-il->scheme handler)))
-
-
- ((<abort> tag args tail)
- `(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args)
- ,(tree-il->scheme tail)))))
+(define* (tree-il->scheme e #:optional (env #f) (opts '()))
+ (values ((@ (language scheme decompile-tree-il)
+ decompile-tree-il)
+ e env opts)))
(define (tree-il-fold leaf down up seed tree)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] | Current Thread | [Next in Thread] |