summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/boot-9.scm65
-rw-r--r--module/ice-9/deprecated.scm866
-rw-r--r--module/ice-9/eval.scm15
-rw-r--r--module/ice-9/local-eval.scm6
-rw-r--r--module/ice-9/psyntax-pp.scm36200
-rw-r--r--module/ice-9/psyntax.scm1131
-rw-r--r--module/ice-9/weak-vector.scm15
-rw-r--r--module/language/brainfuck/compile-tree-il.scm54
-rw-r--r--module/language/ecmascript/compile-tree-il.scm172
-rw-r--r--module/language/elisp/compile-tree-il.scm207
-rw-r--r--module/language/tree-il.scm163
-rw-r--r--module/language/tree-il/analyze.scm70
-rw-r--r--module/language/tree-il/canonicalize.scm14
-rw-r--r--module/language/tree-il/compile-glil.scm438
-rw-r--r--module/language/tree-il/debug.scm23
-rw-r--r--module/language/tree-il/fix-letrec.scm19
-rw-r--r--module/language/tree-il/peval.scm425
-rw-r--r--module/language/tree-il/primitives.scm75
-rw-r--r--module/language/tree-il/spec.scm6
-rw-r--r--module/oop/goops.scm200
-rw-r--r--module/srfi/srfi-35.scm16
-rw-r--r--module/system/foreign.scm4
22 files changed, 18187 insertions, 21997 deletions
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 41ce92483..a7cd47ae1 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -962,15 +962,11 @@ VALUE."
;; properties within the object itself.
(define (make-object-property)
- (define-syntax-rule (with-mutex lock exp)
- (dynamic-wind (lambda () (lock-mutex lock))
- (lambda () exp)
- (lambda () (unlock-mutex lock))))
- (let ((prop (make-weak-key-hash-table))
- (lock (make-mutex)))
+ ;; Weak tables are thread-safe.
+ (let ((prop (make-weak-key-hash-table)))
(make-procedure-with-setter
- (lambda (obj) (with-mutex lock (hashq-ref prop obj)))
- (lambda (obj val) (with-mutex lock (hashq-set! prop obj val))))))
+ (lambda (obj) (hashq-ref prop obj))
+ (lambda (obj val) (hashq-set! prop obj val)))))
@@ -1049,16 +1045,13 @@ VALUE."
;; 0: type-name, 1: fields, 2: constructor
(define record-type-vtable
- ;; FIXME: This should just call make-vtable, not make-vtable-vtable; but for
- ;; that we need to expose the bare vtable-vtable to Scheme.
- (make-vtable-vtable "prprpw" 0
- (lambda (s p)
- (cond ((eq? s record-type-vtable)
- (display "#<record-type-vtable>" p))
- (else
- (display "#<record-type " p)
- (display (record-type-name s) p)
- (display ">" p))))))
+ (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
+ (lambda (s p)
+ (display "#<record-type " p)
+ (display (record-type-name s) p)
+ (display ">" p)))))
+ (set-struct-vtable-name! s 'record-type)
+ s))
(define (record-type? obj)
(and (struct? obj) (eq? record-type-vtable (struct-vtable obj))))
@@ -1674,7 +1667,7 @@ VALUE."
((define-record-type
(lambda (x)
(define (make-id scope . fragments)
- (datum->syntax #'scope
+ (datum->syntax scope
(apply symbol-append
(map (lambda (x)
(if (symbol? x) x (syntax->datum x)))
@@ -2151,33 +2144,6 @@ VALUE."
(define (module-define-submodule! module name submodule)
(hashq-set! (module-submodules module) name submodule))
-;; It used to be, however, that module names were also present in the
-;; value namespace. When we enable deprecated code, we preserve this
-;; legacy behavior.
-;;
-;; These shims are defined here instead of in deprecated.scm because we
-;; need their definitions before loading other modules.
-;;
-(begin-deprecated
- (define (module-ref-submodule module name)
- (or (hashq-ref (module-submodules module) name)
- (and (module-submodule-binder module)
- ((module-submodule-binder module) module name))
- (let ((var (module-local-variable module name)))
- (and var (variable-bound? var) (module? (variable-ref var))
- (begin
- (warn "module" module "not in submodules table")
- (variable-ref var))))))
-
- (define (module-define-submodule! module name submodule)
- (let ((var (module-local-variable module name)))
- (if (and var
- (or (not (variable-bound? var))
- (not (module? (variable-ref var)))))
- (warn "defining module" module ": not overriding local definition" var)
- (module-define! module name submodule)))
- (hashq-set! (module-submodules module) name submodule)))
-
;;; {Module-based Loading}
@@ -3370,13 +3336,6 @@ module '(ice-9 q) '(make-q q-length))}."
(process-use-modules (list quoted-args ...))
*unspecified*))))))
-(define-syntax-rule (use-syntax spec ...)
- (begin
- (eval-when (eval load compile expand)
- (issue-deprecation-warning
- "`use-syntax' is deprecated. Please contact guile-devel for more info."))
- (use-modules spec ...)))
-
(include-from-path "ice-9/r6rs-libraries")
(define-syntax-rule (define-private foo bar)
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index ef2bc2422..6b39e7a7c 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011 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
@@ -16,866 +16,4 @@
;;;;
(define-module (ice-9 deprecated)
- #:export (substring-move-left! substring-move-right!
- dynamic-maybe-call dynamic-maybe-link
- try-module-linked try-module-dynamic-link
- list* feature? eval-case unmemoize-expr
- $asinh
- $acosh
- $atanh
- $sqrt
- $abs
- $exp
- $expt
- $log
- $sin
- $cos
- $tan
- $asin
- $acos
- $atan
- $sinh
- $cosh
- $tanh
- closure?
- %nil
- @bind
- bad-throw
- error-catching-loop
- error-catching-repl
- scm-style-repl
- apply-to-args
- has-suffix?
- scheme-file-suffix
- get-option
- for-next-option
- display-usage-report
- transform-usage-lambda
- collect
- assert-repl-silence
- assert-repl-print-unspecified
- assert-repl-verbosity
- set-repl-prompt!
- set-batch-mode?!
- repl
- pre-unwind-handler-dispatch
- default-pre-unwind-handler
- handle-system-error
- stack-saved?
- the-last-stack
- save-stack
- named-module-use!
- top-repl
- turn-on-debugging
- read-hash-procedures
- process-define-module
- fluid-let-syntax))
-
-
-;;;; Deprecated definitions.
-
-(define substring-move-left!
- (lambda args
- (issue-deprecation-warning
- "`substring-move-left!' is deprecated. Use `substring-move!' instead.")
- (apply substring-move! args)))
-(define substring-move-right!
- (lambda args
- (issue-deprecation-warning
- "`substring-move-right!' is deprecated. Use `substring-move!' instead.")
- (apply substring-move! args)))
-
-
-
-;; This method of dynamically linking Guile Extensions is deprecated.
-;; Use `load-extension' explicitly from Scheme code instead.
-
-(define (split-c-module-name str)
- (let loop ((rev '())
- (start 0)
- (pos 0)
- (end (string-length str)))
- (cond
- ((= pos end)
- (reverse (cons (string->symbol (substring str start pos)) rev)))
- ((eq? (string-ref str pos) #\space)
- (loop (cons (string->symbol (substring str start pos)) rev)
- (+ pos 1)
- (+ pos 1)
- end))
- (else
- (loop rev start (+ pos 1) end)))))
-
-(define (convert-c-registered-modules dynobj)
- (let ((res (map (lambda (c)
- (list (split-c-module-name (car c)) (cdr c) dynobj))
- (c-registered-modules))))
- (c-clear-registered-modules)
- res))
-
-(define registered-modules '())
-
-(define (register-modules dynobj)
- (set! registered-modules
- (append! (convert-c-registered-modules dynobj)
- registered-modules)))
-
-(define (warn-autoload-deprecation modname)
- (issue-deprecation-warning
- "Autoloading of compiled code modules is deprecated."
- "Write a Scheme file instead that uses `load-extension'.")
- (issue-deprecation-warning
- (simple-format #f "(You just autoloaded module ~S.)" modname)))
-
-(define (init-dynamic-module modname)
- ;; Register any linked modules which have been registered on the C level
- (register-modules #f)
- (or-map (lambda (modinfo)
- (if (equal? (car modinfo) modname)
- (begin
- (warn-autoload-deprecation modname)
- (set! registered-modules (delq! modinfo registered-modules))
- (let ((mod (resolve-module modname #f)))
- (save-module-excursion
- (lambda ()
- (set-current-module mod)
- (set-module-public-interface! mod mod)
- (dynamic-call (cadr modinfo) (caddr modinfo))
- ))
- #t))
- #f))
- registered-modules))
-
-(define (dynamic-maybe-call name dynobj)
- (issue-deprecation-warning
- "`dynamic-maybe-call' is deprecated. "
- "Wrap `dynamic-call' in a `false-if-exception' yourself.")
- (false-if-exception (dynamic-call name dynobj)))
-
-
-(define (dynamic-maybe-link filename)
- (issue-deprecation-warning
- "`dynamic-maybe-link' is deprecated. "
- "Wrap `dynamic-link' in a `false-if-exception' yourself.")
- (false-if-exception (dynamic-link filename)))
-
-(define (find-and-link-dynamic-module module-name)
- (define (make-init-name mod-name)
- (string-append "scm_init"
- (list->string (map (lambda (c)
- (if (or (char-alphabetic? c)
- (char-numeric? c))
- c
- #\_))
- (string->list mod-name)))
- "_module"))
-
- ;; Put the subdirectory for this module in the car of SUBDIR-AND-LIBNAME,
- ;; and the `libname' (the name of the module prepended by `lib') in the cdr
- ;; field. For example, if MODULE-NAME is the list (inet tcp-ip udp), then
- ;; SUBDIR-AND-LIBNAME will be the pair ("inet/tcp-ip" . "libudp").
- (let ((subdir-and-libname
- (let loop ((dirs "")
- (syms module-name))
- (if (null? (cdr syms))
- (cons dirs (string-append "lib" (symbol->string (car syms))))
- (loop (string-append dirs (symbol->string (car syms)) "/")
- (cdr syms)))))
- (init (make-init-name (apply string-append
- (map (lambda (s)
- (string-append "_"
- (symbol->string s)))
- module-name)))))
- (let ((subdir (car subdir-and-libname))
- (libname (cdr subdir-and-libname)))
-
- ;; Now look in each dir in %LOAD-PATH for `subdir/libfoo.la'. If that
- ;; file exists, fetch the dlname from that file and attempt to link
- ;; against it. If `subdir/libfoo.la' does not exist, or does not seem
- ;; to name any shared library, look for `subdir/libfoo.so' instead and
- ;; link against that.
- (let check-dirs ((dir-list %load-path))
- (if (null? dir-list)
- #f
- (let* ((dir (in-vicinity (car dir-list) subdir))
- (sharlib-full
- (or (try-using-libtool-name dir libname)
- (try-using-sharlib-name dir libname))))
- (if (and sharlib-full (file-exists? sharlib-full))
- (link-dynamic-module sharlib-full init)
- (check-dirs (cdr dir-list)))))))))
-
-(define (try-using-libtool-name libdir libname)
- (let ((libtool-filename (in-vicinity libdir
- (string-append libname ".la"))))
- (and (file-exists? libtool-filename)
- libtool-filename)))
-
-(define (try-using-sharlib-name libdir libname)
- (in-vicinity libdir (string-append libname ".so")))
-
-(define (link-dynamic-module filename initname)
- ;; Register any linked modules which have been registered on the C level
- (register-modules #f)
- (let ((dynobj (dynamic-link filename)))
- (dynamic-call initname dynobj)
- (register-modules dynobj)))
-
-(define (try-module-linked module-name)
- (issue-deprecation-warning
- "`try-module-linked' is deprecated."
- "See the manual for how more on C extensions.")
- (init-dynamic-module module-name))
-
-(define (try-module-dynamic-link module-name)
- (issue-deprecation-warning
- "`try-module-dynamic-link' is deprecated."
- "See the manual for how more on C extensions.")
- (and (find-and-link-dynamic-module module-name)
- (init-dynamic-module module-name)))
-
-
-(define (list* . args)
- (issue-deprecation-warning "'list*' is deprecated. Use 'cons*' instead.")
- (apply cons* args))
-
-(define (feature? sym)
- (issue-deprecation-warning
- "`feature?' is deprecated. Use `provided?' instead.")
- (provided? sym))
-
-(define-macro (eval-case . clauses)
- (issue-deprecation-warning
- "`eval-case' is deprecated. Use `eval-when' instead.")
- ;; Practically speaking, eval-case only had load-toplevel and else as
- ;; conditions.
- (cond
- ((assoc-ref clauses '(load-toplevel))
- => (lambda (exps)
- ;; the *unspecified so that non-toplevel definitions will be
- ;; caught
- `(begin *unspecified* . ,exps)))
- ((assoc-ref clauses 'else)
- => (lambda (exps)
- `(begin *unspecified* . ,exps)))
- (else
- `(begin))))
-
-;; The strange prototype system for uniform arrays has been
-;; deprecated.
-(read-hash-extend
- #\y
- (lambda (c port)
- (issue-deprecation-warning
- "The `#y' bytevector syntax is deprecated. Use `#s8' instead.")
- (let ((x (read port)))
- (cond
- ((list? x) (list->s8vector x))
- (else (error "#y needs to be followed by a list" x))))))
-
-(define (unmemoize-expr . args)
- (issue-deprecation-warning
- "`unmemoize-expr' is deprecated. Use `unmemoize-expression' instead.")
- (apply unmemoize-expression args))
-
-(define ($asinh z)
- (issue-deprecation-warning
- "`$asinh' is deprecated. Use `asinh' instead.")
- (asinh z))
-(define ($acosh z)
- (issue-deprecation-warning
- "`$acosh' is deprecated. Use `acosh' instead.")
- (acosh z))
-(define ($atanh z)
- (issue-deprecation-warning
- "`$atanh' is deprecated. Use `atanh' instead.")
- (atanh z))
-(define ($sqrt z)
- (issue-deprecation-warning
- "`$sqrt' is deprecated. Use `sqrt' instead.")
- (sqrt z))
-(define ($abs z)
- (issue-deprecation-warning
- "`$abs' is deprecated. Use `abs' instead.")
- (abs z))
-(define ($exp z)
- (issue-deprecation-warning
- "`$exp' is deprecated. Use `exp' instead.")
- (exp z))
-(define ($expt z1 z2)
- (issue-deprecation-warning
- "`$expt' is deprecated. Use `expt' instead.")
- (expt z1 z2))
-(define ($log z)
- (issue-deprecation-warning
- "`$log' is deprecated. Use `log' instead.")
- (log z))
-(define ($sin z)
- (issue-deprecation-warning
- "`$sin' is deprecated. Use `sin' instead.")
- (sin z))
-(define ($cos z)
- (issue-deprecation-warning
- "`$cos' is deprecated. Use `cos' instead.")
- (cos z))
-(define ($tan z)
- (issue-deprecation-warning
- "`$tan' is deprecated. Use `tan' instead.")
- (tan z))
-(define ($asin z)
- (issue-deprecation-warning
- "`$asin' is deprecated. Use `asin' instead.")
- (asin z))
-(define ($acos z)
- (issue-deprecation-warning
- "`$acos' is deprecated. Use `acos' instead.")
- (acos z))
-(define ($atan z)
- (issue-deprecation-warning
- "`$atan' is deprecated. Use `atan' instead.")
- (atan z))
-(define ($sinh z)
- (issue-deprecation-warning
- "`$sinh' is deprecated. Use `sinh' instead.")
- (sinh z))
-(define ($cosh z)
- (issue-deprecation-warning
- "`$cosh' is deprecated. Use `cosh' instead.")
- (cosh z))
-(define ($tanh z)
- (issue-deprecation-warning
- "`$tanh' is deprecated. Use `tanh' instead.")
- (tanh z))
-
-(define (closure? x)
- (issue-deprecation-warning
- "`closure?' is deprecated. Use `procedure?' instead.")
- (procedure? x))
-
-(define %nil #nil)
-
-;;; @bind is used by the old elisp code as a dynamic scoping mechanism.
-;;; Please let the Guile developers know if you are using this macro.
-;;;
-(define-syntax @bind
- (lambda (x)
- (define (bound-member id ids)
- (cond ((null? ids) #f)
- ((bound-identifier=? id (car ids)) #t)
- ((bound-member (car ids) (cdr ids)))))
-
- (issue-deprecation-warning
- "`@bind' is deprecated. Use `with-fluids' instead.")
-
- (syntax-case x ()
- ((_ () b0 b1 ...)
- #'(let () b0 b1 ...))
- ((_ ((id val) ...) b0 b1 ...)
- (and-map identifier? #'(id ...))
- (if (let lp ((ids #'(id ...)))
- (cond ((null? ids) #f)
- ((bound-member (car ids) (cdr ids)) #t)
- (else (lp (cdr ids)))))
- (syntax-violation '@bind "duplicate bound identifier" x)
- (with-syntax (((old-v ...) (generate-temporaries #'(id ...)))
- ((v ...) (generate-temporaries #'(id ...))))
- #'(let ((old-v id) ...
- (v val) ...)
- (dynamic-wind
- (lambda ()
- (set! id v) ...)
- (lambda () b0 b1 ...)
- (lambda ()
- (set! id old-v) ...)))))))))
-
-;; There are deprecated definitions for module-ref-submodule and
-;; module-define-submodule! in boot-9.scm.
-
-;; Define (%app) and (%app modules), and have (app) alias (%app). This
-;; side-effects the-root-module, both to the submodules table and (through
-;; module-define-submodule! above) the obarray.
-;;
-(let ((%app (make-module 31)))
- (set-module-name! %app '(%app))
- (module-define-submodule! the-root-module '%app %app)
- (module-define-submodule! the-root-module 'app %app)
- (module-define-submodule! %app 'modules (resolve-module '() #f)))
-
-;; Allow code that poked %module-public-interface to keep on working.
-;;
-(set! module-public-interface
- (let ((getter module-public-interface))
- (lambda (mod)
- (or (getter mod)
- (cond
- ((and=> (module-local-variable mod '%module-public-interface)
- variable-ref)
- => (lambda (iface)
- (issue-deprecation-warning
-"Setting a module's public interface via munging %module-public-interface is
-deprecated. Use set-module-public-interface! instead.")
- (set-module-public-interface! mod iface)
- iface))
- (else #f))))))
-
-(set! set-module-public-interface!
- (let ((setter set-module-public-interface!))
- (lambda (mod iface)
- (setter mod iface)
- (module-define! mod '%module-public-interface iface))))
-
-(define (bad-throw key . args)
- (issue-deprecation-warning
- "`bad-throw' in the default environment is deprecated.
-Find it in the `(ice-9 scm-style-repl)' module instead.")
- (apply (@ (ice-9 scm-style-repl) bad-throw) key args))
-
-(define (error-catching-loop thunk)
- (issue-deprecation-warning
- "`error-catching-loop' in the default environment is deprecated.
-Find it in the `(ice-9 scm-style-repl)' module instead.")
- ((@ (ice-9 scm-style-repl) error-catching-loop) thunk))
-
-(define (error-catching-repl r e p)
- (issue-deprecation-warning
- "`error-catching-repl' in the default environment is deprecated.
-Find it in the `(ice-9 scm-style-repl)' module instead.")
- ((@ (ice-9 scm-style-repl) error-catching-repl) r e p))
-
-(define (scm-style-repl)
- (issue-deprecation-warning
- "`scm-style-repl' in the default environment is deprecated.
-Find it in the `(ice-9 scm-style-repl)' module instead, or
-better yet, use the repl from `(system repl repl)'.")
- ((@ (ice-9 scm-style-repl) scm-style-repl)))
-
-
-;;; Apply-to-args had the following comment attached to it in boot-9, but it's
-;;; wrong-headed: in the mentioned case, a point should either be a record or
-;;; multiple values.
-;;;
-;;; apply-to-args is functionally redundant with apply and, worse,
-;;; is less general than apply since it only takes two arguments.
-;;;
-;;; On the other hand, apply-to-args is a syntacticly convenient way to
-;;; perform binding in many circumstances when the "let" family of
-;;; of forms don't cut it. E.g.:
-;;;
-;;; (apply-to-args (return-3d-mouse-coords)
-;;; (lambda (x y z)
-;;; ...))
-;;;
-
-(define (apply-to-args args fn)
- (issue-deprecation-warning
- "`apply-to-args' is deprecated. Include a local copy in your program.")
- (apply fn args))
-
-(define (has-suffix? str suffix)
- (issue-deprecation-warning
- "`has-suffix?' is deprecated. Use `string-suffix?' instead (args reversed).")
- (string-suffix? suffix str))
-
-(define scheme-file-suffix
- (lambda ()
- (issue-deprecation-warning
- "`scheme-file-suffix' is deprecated. Use `%load-extensions' instead.")
- ".scm"))
-
-
-
-;;; {Command Line Options}
-;;;
-
-(define (get-option argv kw-opts kw-args return)
- (issue-deprecation-warning
- "`get-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
- (cond
- ((null? argv)
- (return #f #f argv))
-
- ((or (not (eq? #\- (string-ref (car argv) 0)))
- (eq? (string-length (car argv)) 1))
- (return 'normal-arg (car argv) (cdr argv)))
-
- ((eq? #\- (string-ref (car argv) 1))
- (let* ((kw-arg-pos (or (string-index (car argv) #\=)
- (string-length (car argv))))
- (kw (symbol->keyword (substring (car argv) 2 kw-arg-pos)))
- (kw-opt? (member kw kw-opts))
- (kw-arg? (member kw kw-args))
- (arg (or (and (not (eq? kw-arg-pos (string-length (car argv))))
- (substring (car argv)
- (+ kw-arg-pos 1)
- (string-length (car argv))))
- (and kw-arg?
- (begin (set! argv (cdr argv)) (car argv))))))
- (if (or kw-opt? kw-arg?)
- (return kw arg (cdr argv))
- (return 'usage-error kw (cdr argv)))))
-
- (else
- (let* ((char (substring (car argv) 1 2))
- (kw (symbol->keyword char)))
- (cond
-
- ((member kw kw-opts)
- (let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
- (new-argv (if (= 0 (string-length rest-car))
- (cdr argv)
- (cons (string-append "-" rest-car) (cdr argv)))))
- (return kw #f new-argv)))
-
- ((member kw kw-args)
- (let* ((rest-car (substring (car argv) 2 (string-length (car argv))))
- (arg (if (= 0 (string-length rest-car))
- (cadr argv)
- rest-car))
- (new-argv (if (= 0 (string-length rest-car))
- (cddr argv)
- (cdr argv))))
- (return kw arg new-argv)))
-
- (else (return 'usage-error kw argv)))))))
-
-(define (for-next-option proc argv kw-opts kw-args)
- (issue-deprecation-warning
- "`for-next-option' is deprecated. Use `(ice-9 getopt-long)' instead.")
- (let loop ((argv argv))
- (get-option argv kw-opts kw-args
- (lambda (opt opt-arg argv)
- (and opt (proc opt opt-arg argv loop))))))
-
-(define (display-usage-report kw-desc)
- (issue-deprecation-warning
- "`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
- (for-each
- (lambda (kw)
- (or (eq? (car kw) #t)
- (eq? (car kw) 'else)
- (let* ((opt-desc kw)
- (help (cadr opt-desc))
- (opts (car opt-desc))
- (opts-proper (if (string? (car opts)) (cdr opts) opts))
- (arg-name (if (string? (car opts))
- (string-append "<" (car opts) ">")
- ""))
- (left-part (string-append
- (with-output-to-string
- (lambda ()
- (map (lambda (x) (display (keyword->symbol x)) (display " "))
- opts-proper)))
- arg-name))
- (middle-part (if (and (< (string-length left-part) 30)
- (< (string-length help) 40))
- (make-string (- 30 (string-length left-part)) #\ )
- "\n\t")))
- (display left-part)
- (display middle-part)
- (display help)
- (newline))))
- kw-desc))
-
-(define (transform-usage-lambda cases)
- (issue-deprecation-warning
- "`display-usage-report' is deprecated. Use `(ice-9 getopt-long)' instead.")
- (let* ((raw-usage (delq! 'else (map car cases)))
- (usage-sans-specials (map (lambda (x)
- (or (and (not (list? x)) x)
- (and (symbol? (car x)) #t)
- (and (boolean? (car x)) #t)
- x))
- raw-usage))
- (usage-desc (delq! #t usage-sans-specials))
- (kw-desc (map car usage-desc))
- (kw-opts (apply append (map (lambda (x) (and (not (string? (car x))) x)) kw-desc)))
- (kw-args (apply append (map (lambda (x) (and (string? (car x)) (cdr x))) kw-desc)))
- (transmogrified-cases (map (lambda (case)
- (cons (let ((opts (car case)))
- (if (or (boolean? opts) (eq? 'else opts))
- opts
- (cond
- ((symbol? (car opts)) opts)
- ((boolean? (car opts)) opts)
- ((string? (caar opts)) (cdar opts))
- (else (car opts)))))
- (cdr case)))
- cases)))
- `(let ((%display-usage (lambda () (display-usage-report ',usage-desc))))
- (lambda (%argv)
- (let %next-arg ((%argv %argv))
- (get-option %argv
- ',kw-opts
- ',kw-args
- (lambda (%opt %arg %new-argv)
- (case %opt
- ,@ transmogrified-cases))))))))
-
-
-
-;;; {collect}
-;;;
-;;; Similar to `begin' but returns a list of the results of all constituent
-;;; forms instead of the result of the last form.
-;;;
-
-(define-syntax collect
- (lambda (x)
- (issue-deprecation-warning
- "`collect' is deprecated. Define it yourself.")
- (syntax-case x ()
- ((_) #''())
- ((_ x x* ...)
- #'(let ((val x))
- (cons val (collect x* ...)))))))
-
-
-
-
-(define (assert-repl-silence v)
- (issue-deprecation-warning
- "`assert-repl-silence' has moved to `(ice-9 scm-style-repl)'.")
- ((@ (ice-9 scm-style-repl) assert-repl-silence) v))
-
-(define (assert-repl-print-unspecified v)
- (issue-deprecation-warning
- "`assert-repl-print-unspecified' has moved to `(ice-9 scm-style-repl)'.")
- ((@ (ice-9 scm-style-repl) assert-repl-print-unspecified) v))
-
-(define (assert-repl-verbosity v)
- (issue-deprecation-warning
- "`assert-repl-verbosity' has moved to `(ice-9 scm-style-repl)'.")
- ((@ (ice-9 scm-style-repl) assert-repl-verbosity) v))
-
-(define (set-repl-prompt! v)
- (issue-deprecation-warning
- "`set-repl-prompt!' is deprecated. Use `repl-default-prompt-set!' from
-the `(system repl common)' module.")
- ;; Avoid @, as when bootstrapping it will cause the (system repl common)
- ;; module to be loaded at expansion time, which eventually loads srfi-1, but
- ;; that fails due to an unbuilt supporting lib... grrrrrrrrr.
- ((module-ref (resolve-interface '(system repl common))
- 'repl-default-prompt-set!)
- v))
-
-(define (set-batch-mode?! arg)
- (cond
- (arg
- (issue-deprecation-warning
- "`set-batch-mode?!' is deprecated. Use `ensure-batch-mode!' instead.")
- (ensure-batch-mode!))
- (else
- (issue-deprecation-warning
- "`set-batch-mode?!' with an argument of `#f' is deprecated. Use the
-`*repl-stack*' fluid instead.")
- #t)))
-
-(define (repl read evaler print)
- (issue-deprecation-warning
- "`repl' is deprecated. Define it yourself.")
- (let loop ((source (read (current-input-port))))
- (print (evaler source))
- (loop (read (current-input-port)))))
-
-(define (pre-unwind-handler-dispatch key . args)
- (issue-deprecation-warning
- "`pre-unwind-handler-dispatch' is deprecated. Use
-`default-pre-unwind-handler' from `(ice-9 scm-style-repl)' directly.")
- (apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
-
-(define (default-pre-unwind-handler key . args)
- (issue-deprecation-warning
- "`default-pre-unwind-handler' is deprecated. Use it from
-`(ice-9 scm-style-repl)' if you need it.")
- (apply (@ (ice-9 scm-style-repl) default-pre-unwind-handler) key args))
-
-(define (handle-system-error key . args)
- (issue-deprecation-warning
- "`handle-system-error' is deprecated. Use it from
-`(ice-9 scm-style-repl)' if you need it.")
- (apply (@ (ice-9 scm-style-repl) handle-system-error) key args))
-
-(define-syntax stack-saved?
- (make-variable-transformer
- (lambda (x)
- (issue-deprecation-warning
- "`stack-saved?' is deprecated. Use it from
-`(ice-9 save-stack)' if you need it.")
- (syntax-case x (set!)
- ((set! id val)
- (identifier? #'id)
- #'(set! (@ (ice-9 save-stack) stack-saved?) val))
- (id
- (identifier? #'id)
- #'(@ (ice-9 save-stack) stack-saved?))))))
-
-(define-syntax the-last-stack
- (lambda (x)
- (issue-deprecation-warning
- "`the-last-stack' is deprecated. Use it from `(ice-9 save-stack)'
-if you need it.")
- (syntax-case x ()
- (id
- (identifier? #'id)
- #'(@ (ice-9 save-stack) the-last-stack)))))
-
-(define (save-stack . args)
- (issue-deprecation-warning
- "`save-stack' is deprecated. Use it from `(ice-9 save-stack)' if you need
-it.")
- (apply (@ (ice-9 save-stack) save-stack) args))
-
-(define (named-module-use! user usee)
- (issue-deprecation-warning
- "`named-module-use!' is deprecated. Define it yourself if you need it.")
- (module-use! (resolve-module user) (resolve-interface usee)))
-
-(define (top-repl)
- (issue-deprecation-warning
- "`top-repl' has moved to the `(ice-9 top-repl)' module.")
- ((module-ref (resolve-module '(ice-9 top-repl)) 'top-repl)))
-
-(set! debug-enable
- (let ((debug-enable debug-enable))
- (lambda opts
- (if (memq 'debug opts)
- (begin
- (issue-deprecation-warning
- "`(debug-enable 'debug)' is obsolete and has no effect."
- "Remove it from your code.")
- (apply debug-enable (delq 'debug opts)))
- (apply debug-enable opts)))))
-
-(define (turn-on-debugging)
- (issue-deprecation-warning
- "`(turn-on-debugging)' is obsolete and usually has no effect."
- "Debugging capabilities are present by default.")
- (debug-enable 'backtrace)
- (read-enable 'positions))
-
-(define (read-hash-procedures-warning)
- (issue-deprecation-warning
- "`read-hash-procedures' is deprecated."
- "Use the fluid `%read-hash-procedures' instead."))
-
-(define-syntax read-hash-procedures
- (identifier-syntax
- (_
- (begin (read-hash-procedures-warning)
- (fluid-ref %read-hash-procedures)))
- ((set! _ expr)
- (begin (read-hash-procedures-warning)
- (fluid-set! %read-hash-procedures expr)))))
-
-(define (process-define-module args)
- (define (missing kw)
- (error "missing argument to define-module keyword" kw))
- (define (unrecognized arg)
- (error "unrecognized define-module argument" arg))
-
- (issue-deprecation-warning
- "`process-define-module' is deprecated. Use `define-module*' instead.")
-
- (let ((name (car args))
- (filename #f)
- (pure? #f)
- (version #f)
- (system? #f)
- (duplicates '())
- (transformer #f))
- (let loop ((kws (cdr args))
- (imports '())
- (exports '())
- (re-exports '())
- (replacements '())
- (autoloads '()))
- (if (null? kws)
- (define-module* name
- #:filename filename #:pure pure? #:version version
- #:duplicates duplicates #:transformer transformer
- #:imports (reverse! imports)
- #:exports exports
- #:re-exports re-exports
- #:replacements replacements
- #:autoloads autoloads)
- (case (car kws)
- ((#:use-module #:use-syntax)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (cond
- ((equal? (cadr kws) '(ice-9 syncase))
- (issue-deprecation-warning
- "(ice-9 syncase) is deprecated. Support for syntax-case is now in Guile core.")
- (loop (cddr kws)
- imports exports re-exports replacements autoloads))
- (else
- (let ((iface-spec (cadr kws)))
- (if (eq? (car kws) #:use-syntax)
- (set! transformer iface-spec))
- (loop (cddr kws)
- (cons iface-spec imports) exports re-exports
- replacements autoloads)))))
- ((#:autoload)
- (or (and (pair? (cdr kws)) (pair? (cddr kws)))
- (missing (car kws)))
- (let ((name (cadr kws))
- (bindings (caddr kws)))
- (loop (cdddr kws)
- imports exports re-exports
- replacements (cons* name bindings autoloads))))
- ((#:no-backtrace)
- ;; FIXME: deprecate?
- (set! system? #t)
- (loop (cdr kws)
- imports exports re-exports replacements autoloads))
- ((#:pure)
- (set! pure? #t)
- (loop (cdr kws)
- imports exports re-exports replacements autoloads))
- ((#:version)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (set! version (cadr kws))
- (loop (cddr kws)
- imports exports re-exports replacements autoloads))
- ((#:duplicates)
- (if (not (pair? (cdr kws)))
- (missing (car kws)))
- (set! duplicates (cadr kws))
- (loop (cddr kws)
- imports exports re-exports replacements autoloads))
- ((#:export #:export-syntax)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (loop (cddr kws)
- imports (append exports (cadr kws)) re-exports
- replacements autoloads))
- ((#:re-export #:re-export-syntax)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (loop (cddr kws)
- imports exports (append re-exports (cadr kws))
- replacements autoloads))
- ((#:replace #:replace-syntax)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (loop (cddr kws)
- imports exports re-exports
- (append replacements (cadr kws)) autoloads))
- ((#:filename)
- (or (pair? (cdr kws))
- (missing (car kws)))
- (set! filename (cadr kws))
- (loop (cddr kws)
- imports exports re-exports replacements autoloads))
- (else
- (unrecognized kws)))))))
-
-(define-syntax fluid-let-syntax
- (lambda (x)
- (issue-deprecation-warning
- "`fluid-let-syntax' is deprecated. Use syntax parameters instead.")
- (syntax-case x ()
- ((_ ((k v) ...) body0 body ...)
- #'(syntax-parameterize ((k v) ...)
- body0 body ...)))))
+ #:export ())
diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm
index 74b85329d..d993db0c7 100644
--- a/module/ice-9/eval.scm
+++ b/module/ice-9/eval.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
-;;;; Copyright (C) 2009, 2010
+;;;; Copyright (C) 2009, 2010, 2011
;;;; Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -399,14 +399,11 @@
0 #f '() #f)
(apply make-general-closure (capture-env env) body nreq tail))))
- (('begin (first . rest))
- (let lp ((first first) (rest rest))
- (if (null? rest)
- (eval first env)
- (begin
- (eval first env)
- (lp (car rest) (cdr rest))))))
-
+ (('seq (head . tail))
+ (begin
+ (eval head env)
+ (eval tail env)))
+
(('lexical-set! (n . x))
(let ((val (eval x env)))
(list-set! env n val)))
diff --git a/module/ice-9/local-eval.scm b/module/ice-9/local-eval.scm
index 28f30b991..493dbed0d 100644
--- a/module/ice-9/local-eval.scm
+++ b/module/ice-9/local-eval.scm
@@ -180,7 +180,11 @@
t)
patterns))))
(else
- (error "what" type val))))))))))
+ ;; Interestingly, this case can include globals (and
+ ;; global macros), now that Guile tracks which globals it
+ ;; introduces. Not sure what to do here! For now, punt.
+ ;;
+ (lp ids capture formals wrappers patterns))))))))))
(define-syntax the-environment
(lambda (x)
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 24343d8c8..847a25b3f 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -1,1671 +1,2176 @@
(eval-when (compile) (set-current-module (resolve-module (quote (guile)))))
(if #f #f)
-(let ((session-id-6510 (if #f #f))
- (transformer-environment-6571 (if #f #f)))
+(let ((session-id-4511 (if #f #f))
+ (transformer-environment-4572 (if #f #f)))
(letrec*
- ((top-level-eval-hook-6508
- (lambda (x-29318 mod-29319)
- (primitive-eval x-29318)))
- (get-global-definition-hook-6512
- (lambda (symbol-17709 module-17710)
- (begin
- (if (if (not module-17710) (current-module) #f)
- (warn "module system is booted, we should have a module"
- symbol-17709))
- (let ((v-17711
- (module-variable
- (if module-17710
- (resolve-module (cdr module-17710))
- (current-module))
- symbol-17709)))
- (if v-17711
- (if (variable-bound? v-17711)
- (let ((val-17713 (variable-ref v-17711)))
- (if (macro? val-17713)
- (if (macro-type val-17713)
- (cons (macro-type val-17713)
- (macro-binding val-17713))
- #f)
- #f))
- #f)
- #f)))))
- (maybe-name-value!-6514
- (lambda (name-17990 val-17991)
- (if (if (struct? val-17991)
- (eq? (struct-vtable val-17991)
- (vector-ref %expanded-vtables 13))
+ ((top-level-eval-hook-4509
+ (lambda (x-36254 mod-36255)
+ (primitive-eval x-36254)))
+ (maybe-name-value!-4515
+ (lambda (name-19069 val-19070)
+ (if (if (struct? val-19070)
+ (eq? (struct-vtable val-19070)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-17998 (struct-ref val-17991 1)))
- (if (not (assq 'name meta-17998))
- (let ((v-18003
- (cons (cons 'name name-17990) meta-17998)))
- (struct-set! val-17991 1 v-18003)))))))
- (build-application-6516
- (lambda (source-17715 fun-exp-17716 arg-exps-17717)
+ (let ((meta-19077 (struct-ref val-19070 1)))
+ (if (not (assq 'name meta-19077))
+ (let ((v-19082
+ (cons (cons 'name name-19069) meta-19077)))
+ (struct-set! val-19070 1 v-19082)))))))
+ (build-call-4517
+ (lambda (source-18814 fun-exp-18815 arg-exps-18816)
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- source-17715
- fun-exp-17716
- arg-exps-17717)))
- (build-conditional-6517
- (lambda (source-17723
- test-exp-17724
- then-exp-17725
- else-exp-17726)
+ source-18814
+ fun-exp-18815
+ arg-exps-18816)))
+ (build-conditional-4518
+ (lambda (source-18822
+ test-exp-18823
+ then-exp-18824
+ else-exp-18825)
(make-struct/no-tail
(vector-ref %expanded-vtables 10)
- source-17723
- test-exp-17724
- then-exp-17725
- else-exp-17726)))
- (build-dynlet-6518
- (lambda (source-17733 fluids-17734 vals-17735 body-17736)
+ source-18822
+ test-exp-18823
+ then-exp-18824
+ else-exp-18825)))
+ (build-dynlet-4519
+ (lambda (source-18832 fluids-18833 vals-18834 body-18835)
(make-struct/no-tail
- (vector-ref %expanded-vtables 17)
- source-17733
- fluids-17734
- vals-17735
- body-17736)))
- (build-lexical-reference-6519
- (lambda (type-29320 source-29321 name-29322 var-29323)
+ (vector-ref %expanded-vtables 18)
+ source-18832
+ fluids-18833
+ vals-18834
+ body-18835)))
+ (build-lexical-reference-4520
+ (lambda (type-36256 source-36257 name-36258 var-36259)
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- source-29321
- name-29322
- var-29323)))
- (build-lexical-assignment-6520
- (lambda (source-17743 name-17744 var-17745 exp-17746)
+ source-36257
+ name-36258
+ var-36259)))
+ (build-lexical-assignment-4521
+ (lambda (source-18842 name-18843 var-18844 exp-18845)
(begin
- (if (if (struct? exp-17746)
- (eq? (struct-vtable exp-17746)
- (vector-ref %expanded-vtables 13))
+ (if (if (struct? exp-18845)
+ (eq? (struct-vtable exp-18845)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-17762 (struct-ref exp-17746 1)))
- (if (not (assq 'name meta-17762))
- (let ((v-17769
- (cons (cons 'name name-17744) meta-17762)))
- (struct-set! exp-17746 1 v-17769)))))
+ (let ((meta-18861 (struct-ref exp-18845 1)))
+ (if (not (assq 'name meta-18861))
+ (let ((v-18868
+ (cons (cons 'name name-18843) meta-18861)))
+ (struct-set! exp-18845 1 v-18868)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 4)
- source-17743
- name-17744
- var-17745
- exp-17746))))
- (analyze-variable-6521
- (lambda (mod-29329
- var-29330
- modref-cont-29331
- bare-cont-29332)
- (if (not mod-29329)
- (bare-cont-29332 var-29330)
- (let ((kind-29333 (car mod-29329))
- (mod-29334 (cdr mod-29329)))
- (if (eqv? kind-29333 'public)
- (modref-cont-29331 mod-29334 var-29330 #t)
- (if (eqv? kind-29333 'private)
- (if (not (equal? mod-29334 (module-name (current-module))))
- (modref-cont-29331 mod-29334 var-29330 #f)
- (bare-cont-29332 var-29330))
- (if (eqv? kind-29333 'bare)
- (bare-cont-29332 var-29330)
- (if (eqv? kind-29333 'hygiene)
+ source-18842
+ name-18843
+ var-18844
+ exp-18845))))
+ (analyze-variable-4522
+ (lambda (mod-36265
+ var-36266
+ modref-cont-36267
+ bare-cont-36268)
+ (if (not mod-36265)
+ (bare-cont-36268 var-36266)
+ (let ((kind-36269 (car mod-36265))
+ (mod-36270 (cdr mod-36265)))
+ (if (eqv? kind-36269 'public)
+ (modref-cont-36267 mod-36270 var-36266 #t)
+ (if (eqv? kind-36269 'private)
+ (if (not (equal? mod-36270 (module-name (current-module))))
+ (modref-cont-36267 mod-36270 var-36266 #f)
+ (bare-cont-36268 var-36266))
+ (if (eqv? kind-36269 'bare)
+ (bare-cont-36268 var-36266)
+ (if (eqv? kind-36269 'hygiene)
(if (if (not (equal?
- mod-29334
+ mod-36270
(module-name (current-module))))
(module-variable
- (resolve-module mod-29334)
- var-29330)
+ (resolve-module mod-36270)
+ var-36266)
#f)
- (modref-cont-29331 mod-29334 var-29330 #f)
- (bare-cont-29332 var-29330))
+ (modref-cont-36267 mod-36270 var-36266 #f)
+ (bare-cont-36268 var-36266))
(syntax-violation
#f
"bad module kind"
- var-29330
- mod-29334)))))))))
- (build-global-reference-6522
- (lambda (source-29349 var-29350 mod-29351)
- (analyze-variable-6521
- mod-29351
- var-29350
- (lambda (mod-29354 var-29355 public?-29356)
+ var-36266
+ mod-36270)))))))))
+ (build-global-reference-4523
+ (lambda (source-36285 var-36286 mod-36287)
+ (analyze-variable-4522
+ mod-36287
+ var-36286
+ (lambda (mod-36290 var-36291 public?-36292)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
- source-29349
- mod-29354
- var-29355
- public?-29356))
- (lambda (var-29364)
+ source-36285
+ mod-36290
+ var-36291
+ public?-36292))
+ (lambda (var-36299)
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
- source-29349
- var-29364)))))
- (build-global-assignment-6523
- (lambda (source-17778 var-17779 exp-17780 mod-17781)
+ source-36285
+ var-36299)))))
+ (build-global-assignment-4524
+ (lambda (source-18877 var-18878 exp-18879 mod-18880)
(begin
- (if (if (struct? exp-17780)
- (eq? (struct-vtable exp-17780)
- (vector-ref %expanded-vtables 13))
+ (if (if (struct? exp-18879)
+ (eq? (struct-vtable exp-18879)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-17797 (struct-ref exp-17780 1)))
- (if (not (assq 'name meta-17797))
- (let ((v-17804
- (cons (cons 'name var-17779) meta-17797)))
- (struct-set! exp-17780 1 v-17804)))))
- (analyze-variable-6521
- mod-17781
- var-17779
- (lambda (mod-17809 var-17810 public?-17811)
+ (let ((meta-18896 (struct-ref exp-18879 1)))
+ (if (not (assq 'name meta-18896))
+ (let ((v-18903
+ (cons (cons 'name var-18878) meta-18896)))
+ (struct-set! exp-18879 1 v-18903)))))
+ (analyze-variable-4522
+ mod-18880
+ var-18878
+ (lambda (mod-18908 var-18909 public?-18910)
(make-struct/no-tail
(vector-ref %expanded-vtables 6)
- source-17778
- mod-17809
- var-17810
- public?-17811
- exp-17780))
- (lambda (var-17819)
+ source-18877
+ mod-18908
+ var-18909
+ public?-18910
+ exp-18879))
+ (lambda (var-18918)
(make-struct/no-tail
(vector-ref %expanded-vtables 8)
- source-17778
- var-17819
- exp-17780))))))
- (build-global-definition-6524
- (lambda (source-29370 var-29371 exp-29372)
+ source-18877
+ var-18918
+ exp-18879))))))
+ (build-global-definition-4525
+ (lambda (source-36304 var-36305 exp-36306)
(begin
- (if (if (struct? exp-29372)
- (eq? (struct-vtable exp-29372)
- (vector-ref %expanded-vtables 13))
+ (if (if (struct? exp-36306)
+ (eq? (struct-vtable exp-36306)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-29388 (struct-ref exp-29372 1)))
- (if (not (assq 'name meta-29388))
- (let ((v-29395
- (cons (cons 'name var-29371) meta-29388)))
- (struct-set! exp-29372 1 v-29395)))))
+ (let ((meta-36322 (struct-ref exp-36306 1)))
+ (if (not (assq 'name meta-36322))
+ (let ((v-36329
+ (cons (cons 'name var-36305) meta-36322)))
+ (struct-set! exp-36306 1 v-36329)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 9)
- source-29370
- var-29371
- exp-29372))))
- (build-simple-lambda-6525
- (lambda (src-17825
- req-17826
- rest-17827
- vars-17828
- meta-17829
- exp-17830)
- (let ((body-17836
+ source-36304
+ var-36305
+ exp-36306))))
+ (build-simple-lambda-4526
+ (lambda (src-18924
+ req-18925
+ rest-18926
+ vars-18927
+ meta-18928
+ exp-18929)
+ (let ((body-18935
(make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- src-17825
- req-17826
+ (vector-ref %expanded-vtables 15)
+ src-18924
+ req-18925
#f
- rest-17827
+ rest-18926
#f
'()
- vars-17828
- exp-17830
+ vars-18927
+ exp-18929
#f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- src-17825
- meta-17829
- body-17836))))
- (build-sequence-6530
- (lambda (src-29403 exps-29404)
- (if (null? (cdr exps-29404))
- (car exps-29404)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 12)
- src-29403
- exps-29404))))
- (build-let-6531
- (lambda (src-17848
- ids-17849
- vars-17850
- val-exps-17851
- body-exp-17852)
- (begin
- (for-each
- maybe-name-value!-6514
- ids-17849
- val-exps-17851)
- (if (null? vars-17850)
- body-exp-17852
+ (vector-ref %expanded-vtables 14)
+ src-18924
+ meta-18928
+ body-18935))))
+ (build-primcall-4529
+ (lambda (src-18947 name-18948 args-18949)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 12)
+ src-18947
+ name-18948
+ args-18949)))
+ (build-sequence-4532
+ (lambda (src-36337 exps-36338)
+ (if (null? (cdr exps-36338))
+ (car exps-36338)
+ (let ((head-36342 (car exps-36338))
+ (tail-36343
+ (build-sequence-4532 #f (cdr exps-36338))))
(make-struct/no-tail
- (vector-ref %expanded-vtables 15)
- src-17848
- ids-17849
- vars-17850
- val-exps-17851
- body-exp-17852)))))
- (build-named-let-6532
- (lambda (src-17876
- ids-17877
- vars-17878
- val-exps-17879
- body-exp-17880)
- (let ((f-17881 (car vars-17878))
- (f-name-17882 (car ids-17877))
- (vars-17883 (cdr vars-17878))
- (ids-17884 (cdr ids-17877)))
- (let ((proc-17885
- (let ((body-17905
+ (vector-ref %expanded-vtables 13)
+ src-36337
+ head-36342
+ tail-36343)))))
+ (build-named-let-4534
+ (lambda (src-18955
+ ids-18956
+ vars-18957
+ val-exps-18958
+ body-exp-18959)
+ (let ((f-18960 (car vars-18957))
+ (f-name-18961 (car ids-18956))
+ (vars-18962 (cdr vars-18957))
+ (ids-18963 (cdr ids-18956)))
+ (let ((proc-18964
+ (let ((body-18984
(make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- src-17876
- ids-17884
+ (vector-ref %expanded-vtables 15)
+ src-18955
+ ids-18963
#f
#f
#f
'()
- vars-17883
- body-exp-17880
+ vars-18962
+ body-exp-18959
#f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- src-17876
+ (vector-ref %expanded-vtables 14)
+ src-18955
'()
- body-17905))))
+ body-18984))))
(begin
- (if (if (struct? proc-17885)
- (eq? (struct-vtable proc-17885)
- (vector-ref %expanded-vtables 13))
+ (if (if (struct? proc-18964)
+ (eq? (struct-vtable proc-18964)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-17929 (struct-ref proc-17885 1)))
- (if (not (assq 'name meta-17929))
- (let ((v-17936
- (cons (cons 'name f-name-17882) meta-17929)))
- (struct-set! proc-17885 1 v-17936)))))
+ (let ((meta-19008 (struct-ref proc-18964 1)))
+ (if (not (assq 'name meta-19008))
+ (let ((v-19015
+ (cons (cons 'name f-name-18961) meta-19008)))
+ (struct-set! proc-18964 1 v-19015)))))
(for-each
- maybe-name-value!-6514
- ids-17884
- val-exps-17879)
- (let ((names-17960 (list f-name-17882))
- (gensyms-17961 (list f-17881))
- (vals-17962 (list proc-17885))
- (body-17963
- (let ((fun-exp-17967
+ maybe-name-value!-4515
+ ids-18963
+ val-exps-18958)
+ (let ((names-19039 (list f-name-18961))
+ (gensyms-19040 (list f-18960))
+ (vals-19041 (list proc-18964))
+ (body-19042
+ (let ((fun-exp-19046
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- src-17876
- f-name-17882
- f-17881)))
+ src-18955
+ f-name-18961
+ f-18960)))
(make-struct/no-tail
(vector-ref %expanded-vtables 11)
- src-17876
- fun-exp-17967
- val-exps-17879))))
+ src-18955
+ fun-exp-19046
+ val-exps-18958))))
(make-struct/no-tail
- (vector-ref %expanded-vtables 16)
- src-17876
+ (vector-ref %expanded-vtables 17)
+ src-18955
#f
- names-17960
- gensyms-17961
- vals-17962
- body-17963)))))))
- (build-letrec-6533
- (lambda (src-17983
- in-order?-17984
- ids-17985
- vars-17986
- val-exps-17987
- body-exp-17988)
- (if (null? vars-17986)
- body-exp-17988
+ names-19039
+ gensyms-19040
+ vals-19041
+ body-19042)))))))
+ (build-letrec-4535
+ (lambda (src-19062
+ in-order?-19063
+ ids-19064
+ vars-19065
+ val-exps-19066
+ body-exp-19067)
+ (if (null? vars-19065)
+ body-exp-19067
(begin
(for-each
- maybe-name-value!-6514
- ids-17985
- val-exps-17987)
+ maybe-name-value!-4515
+ ids-19064
+ val-exps-19066)
(make-struct/no-tail
- (vector-ref %expanded-vtables 16)
- src-17983
- in-order?-17984
- ids-17985
- vars-17986
- val-exps-17987
- body-exp-17988)))))
- (source-annotation-6542
- (lambda (x-18014)
- (if (if (vector? x-18014)
- (if (= (vector-length x-18014) 4)
- (eq? (vector-ref x-18014 0) 'syntax-object)
+ (vector-ref %expanded-vtables 17)
+ src-19062
+ in-order?-19063
+ ids-19064
+ vars-19065
+ val-exps-19066
+ body-exp-19067)))))
+ (source-annotation-4544
+ (lambda (x-19093)
+ (if (if (vector? x-19093)
+ (if (= (vector-length x-19093) 4)
+ (eq? (vector-ref x-19093 0) 'syntax-object)
#f)
#f)
- (source-annotation-6542 (vector-ref x-18014 1))
- (if (pair? x-18014)
- (let ((props-18029 (source-properties x-18014)))
- (if (pair? props-18029) props-18029 #f))
+ (source-annotation-4544 (vector-ref x-19093 1))
+ (if (pair? x-19093)
+ (let ((props-19108 (source-properties x-19093)))
+ (if (pair? props-19108) props-19108 #f))
#f))))
- (extend-env-6543
- (lambda (labels-18031 bindings-18032 r-18033)
- (if (null? labels-18031)
- r-18033
- (extend-env-6543
- (cdr labels-18031)
- (cdr bindings-18032)
- (cons (cons (car labels-18031) (car bindings-18032))
- r-18033)))))
- (extend-var-env-6544
- (lambda (labels-18034 vars-18035 r-18036)
- (if (null? labels-18034)
- r-18036
- (extend-var-env-6544
- (cdr labels-18034)
- (cdr vars-18035)
- (cons (cons (car labels-18034)
- (cons 'lexical (car vars-18035)))
- r-18036)))))
- (macros-only-env-6545
- (lambda (r-18037)
- (if (null? r-18037)
+ (extend-env-4545
+ (lambda (labels-19110 bindings-19111 r-19112)
+ (if (null? labels-19110)
+ r-19112
+ (extend-env-4545
+ (cdr labels-19110)
+ (cdr bindings-19111)
+ (cons (cons (car labels-19110) (car bindings-19111))
+ r-19112)))))
+ (extend-var-env-4546
+ (lambda (labels-19113 vars-19114 r-19115)
+ (if (null? labels-19113)
+ r-19115
+ (extend-var-env-4546
+ (cdr labels-19113)
+ (cdr vars-19114)
+ (cons (cons (car labels-19113)
+ (cons 'lexical (car vars-19114)))
+ r-19115)))))
+ (macros-only-env-4547
+ (lambda (r-19116)
+ (if (null? r-19116)
'()
- (let ((a-18038 (car r-18037)))
- (if (eq? (car (cdr a-18038)) 'macro)
- (cons a-18038
- (macros-only-env-6545 (cdr r-18037)))
- (macros-only-env-6545 (cdr r-18037)))))))
- (global-extend-6547
- (lambda (type-18040 sym-18041 val-18042)
+ (let ((a-19117 (car r-19116)))
+ (if (let ((t-19120 (car (cdr a-19117))))
+ (if (eq? t-19120 'macro)
+ #t
+ (eq? t-19120 'syntax-parameter)))
+ (cons a-19117
+ (macros-only-env-4547 (cdr r-19116)))
+ (macros-only-env-4547 (cdr r-19116)))))))
+ (global-extend-4548
+ (lambda (type-19122 sym-19123 val-19124)
(module-define!
(current-module)
- sym-18041
+ sym-19123
(make-syntax-transformer
- sym-18041
- type-18040
- val-18042))))
- (id?-6549
- (lambda (x-11853)
- (if (symbol? x-11853)
+ sym-19123
+ type-19122
+ val-19124))))
+ (id?-4550
+ (lambda (x-11889)
+ (if (symbol? x-11889)
#t
- (if (if (vector? x-11853)
- (if (= (vector-length x-11853) 4)
- (eq? (vector-ref x-11853 0) 'syntax-object)
+ (if (if (vector? x-11889)
+ (if (= (vector-length x-11889) 4)
+ (eq? (vector-ref x-11889 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-11853 1))
+ (symbol? (vector-ref x-11889 1))
#f))))
- (gen-labels-6552
- (lambda (ls-18052)
- (if (null? ls-18052)
+ (gen-labels-4553
+ (lambda (ls-19134)
+ (if (null? ls-19134)
'()
(cons (string-append
"l-"
- (session-id-6510)
+ (session-id-4511)
(symbol->string (gensym "-")))
- (gen-labels-6552 (cdr ls-18052))))))
- (make-binding-wrap-6563
- (lambda (ids-18056 labels-18057 w-18058)
- (if (null? ids-18056)
- w-18058
- (cons (car w-18058)
- (cons (let ((labelvec-18059 (list->vector labels-18057)))
- (let ((n-18060 (vector-length labelvec-18059)))
- (let ((symnamevec-18061 (make-vector n-18060))
- (marksvec-18062 (make-vector n-18060)))
+ (gen-labels-4553 (cdr ls-19134))))))
+ (make-binding-wrap-4564
+ (lambda (ids-19138 labels-19139 w-19140)
+ (if (null? ids-19138)
+ w-19140
+ (cons (car w-19140)
+ (cons (let ((labelvec-19141 (list->vector labels-19139)))
+ (let ((n-19142 (vector-length labelvec-19141)))
+ (let ((symnamevec-19143 (make-vector n-19142))
+ (marksvec-19144 (make-vector n-19142)))
(begin
(letrec*
- ((f-18063
- (lambda (ids-18066 i-18067)
- (if (not (null? ids-18066))
+ ((f-19145
+ (lambda (ids-19342 i-19343)
+ (if (not (null? ids-19342))
(call-with-values
(lambda ()
- (let ((x-18070 (car ids-18066)))
- (if (if (vector? x-18070)
+ (let ((x-19346 (car ids-19342)))
+ (if (if (vector? x-19346)
(if (= (vector-length
- x-18070)
+ x-19346)
4)
(eq? (vector-ref
- x-18070
+ x-19346
0)
'syntax-object)
#f)
#f)
(values
- (vector-ref x-18070 1)
- (let ((m1-18086
- (car w-18058))
- (m2-18087
+ (vector-ref x-19346 1)
+ (let ((m1-19362
+ (car w-19140))
+ (m2-19363
(car (vector-ref
- x-18070
+ x-19346
2))))
- (if (null? m2-18087)
- m1-18086
+ (if (null? m2-19363)
+ m1-19362
(append
- m1-18086
- m2-18087))))
+ m1-19362
+ m2-19363))))
(values
- x-18070
- (car w-18058)))))
- (lambda (symname-18107 marks-18108)
+ x-19346
+ (car w-19140)))))
+ (lambda (symname-19383 marks-19384)
(begin
(vector-set!
- symnamevec-18061
- i-18067
- symname-18107)
+ symnamevec-19143
+ i-19343
+ symname-19383)
(vector-set!
- marksvec-18062
- i-18067
- marks-18108)
- (f-18063
- (cdr ids-18066)
- (#{1+}# i-18067)))))))))
- (f-18063 ids-18056 0))
+ marksvec-19144
+ i-19343
+ marks-19384)
+ (f-19145
+ (cdr ids-19342)
+ (#{1+}# i-19343)))))))))
+ (f-19145 ids-19138 0))
(vector
'ribcage
- symnamevec-18061
- marksvec-18062
- labelvec-18059)))))
- (cdr w-18058))))))
- (join-wraps-6565
- (lambda (w1-18117 w2-18118)
- (let ((m1-18119 (car w1-18117))
- (s1-18120 (cdr w1-18117)))
- (if (null? m1-18119)
- (if (null? s1-18120)
- w2-18118
- (cons (car w2-18118)
- (let ((m2-18127 (cdr w2-18118)))
- (if (null? m2-18127)
- s1-18120
- (append s1-18120 m2-18127)))))
- (cons (let ((m2-18136 (car w2-18118)))
- (if (null? m2-18136)
- m1-18119
- (append m1-18119 m2-18136)))
- (let ((m2-18145 (cdr w2-18118)))
- (if (null? m2-18145)
- s1-18120
- (append s1-18120 m2-18145))))))))
- (same-marks?-6567
- (lambda (x-18150 y-18151)
- (if (eq? x-18150 y-18151)
- (eq? x-18150 y-18151)
- (if (not (null? x-18150))
- (if (not (null? y-18151))
- (if (eq? (car x-18150) (car y-18151))
- (same-marks?-6567 (cdr x-18150) (cdr y-18151))
+ symnamevec-19143
+ marksvec-19144
+ labelvec-19141)))))
+ (cdr w-19140))))))
+ (same-marks?-4568
+ (lambda (x-36344 y-36345)
+ (if (eq? x-36344 y-36345)
+ (eq? x-36344 y-36345)
+ (if (not (null? x-36344))
+ (if (not (null? y-36345))
+ (if (eq? (car x-36344) (car y-36345))
+ (same-marks?-4568 (cdr x-36344) (cdr y-36345))
#f)
#f)
#f))))
- (id-var-name-6568
- (lambda (id-18159 w-18160)
+ (id-var-name-4569
+ (lambda (id-36353 w-36354 mod-36355)
(letrec*
- ((search-18161
- (lambda (sym-18222 subst-18223 marks-18224)
- (if (null? subst-18223)
- (values #f marks-18224)
- (let ((fst-18225 (car subst-18223)))
- (if (eq? fst-18225 'shift)
- (search-18161
- sym-18222
- (cdr subst-18223)
- (cdr marks-18224))
- (let ((symnames-18227 (vector-ref fst-18225 1)))
- (if (vector? symnames-18227)
- (let ((n-18239 (vector-length symnames-18227)))
- (letrec*
- ((f-18240
- (lambda (i-18242)
- (if (= i-18242 n-18239)
- (search-18161
- sym-18222
- (cdr subst-18223)
- marks-18224)
- (if (if (eq? (vector-ref
- symnames-18227
- i-18242)
- sym-18222)
- (same-marks?-6567
- marks-18224
- (vector-ref
- (vector-ref fst-18225 2)
- i-18242))
- #f)
- (values
- (vector-ref
- (vector-ref fst-18225 3)
- i-18242)
- marks-18224)
- (f-18240 (#{1+}# i-18242)))))))
- (f-18240 0)))
- (letrec*
- ((f-18275
- (lambda (symnames-18277 i-18278)
- (if (null? symnames-18277)
- (search-18161
- sym-18222
- (cdr subst-18223)
- marks-18224)
- (if (if (eq? (car symnames-18277) sym-18222)
- (same-marks?-6567
- marks-18224
- (list-ref
- (vector-ref fst-18225 2)
- i-18278))
- #f)
- (values
- (list-ref
- (vector-ref fst-18225 3)
- i-18278)
- marks-18224)
- (f-18275
- (cdr symnames-18277)
- (#{1+}# i-18278)))))))
- (f-18275 symnames-18227 0))))))))))
- (if (symbol? id-18159)
- (let ((t-18164
- (search-18161
- id-18159
- (cdr w-18160)
- (car w-18160))))
- (if t-18164 t-18164 id-18159))
- (if (if (vector? id-18159)
- (if (= (vector-length id-18159) 4)
- (eq? (vector-ref id-18159 0) 'syntax-object)
+ ((search-36356
+ (lambda (sym-36422 subst-36423 marks-36424 mod-36425)
+ (if (null? subst-36423)
+ (values #f marks-36424)
+ (let ((fst-36426 (car subst-36423)))
+ (if (eq? fst-36426 'shift)
+ (search-36356
+ sym-36422
+ (cdr subst-36423)
+ (cdr marks-36424)
+ mod-36425)
+ (let ((symnames-36428 (vector-ref fst-36426 1)))
+ (if (vector? symnames-36428)
+ (search-vector-rib-36358
+ sym-36422
+ subst-36423
+ marks-36424
+ symnames-36428
+ fst-36426
+ mod-36425)
+ (search-list-rib-36357
+ sym-36422
+ subst-36423
+ marks-36424
+ symnames-36428
+ fst-36426
+ mod-36425))))))))
+ (search-list-rib-36357
+ (lambda (sym-36603
+ subst-36604
+ marks-36605
+ symnames-36606
+ ribcage-36607
+ mod-36608)
+ (letrec*
+ ((f-36609
+ (lambda (symnames-36612 i-36613)
+ (if (null? symnames-36612)
+ (search-36356
+ sym-36603
+ (cdr subst-36604)
+ marks-36605
+ mod-36608)
+ (if (if (eq? (car symnames-36612) sym-36603)
+ (same-marks?-4568
+ marks-36605
+ (list-ref
+ (vector-ref ribcage-36607 2)
+ i-36613))
+ #f)
+ (let ((n-36759
+ (list-ref
+ (vector-ref ribcage-36607 3)
+ i-36613)))
+ (if (pair? n-36759)
+ (if (equal? mod-36608 (car n-36759))
+ (values (cdr n-36759) marks-36605)
+ (f-36609
+ (cdr symnames-36612)
+ (#{1+}# i-36613)))
+ (values n-36759 marks-36605)))
+ (f-36609 (cdr symnames-36612) (#{1+}# i-36613)))))))
+ (f-36609 symnames-36606 0))))
+ (search-vector-rib-36358
+ (lambda (sym-36764
+ subst-36765
+ marks-36766
+ symnames-36767
+ ribcage-36768
+ mod-36769)
+ (let ((n-36770 (vector-length symnames-36767)))
+ (letrec*
+ ((f-36771
+ (lambda (i-36774)
+ (if (= i-36774 n-36770)
+ (search-36356
+ sym-36764
+ (cdr subst-36765)
+ marks-36766
+ mod-36769)
+ (if (if (eq? (vector-ref symnames-36767 i-36774)
+ sym-36764)
+ (same-marks?-4568
+ marks-36766
+ (vector-ref
+ (vector-ref ribcage-36768 2)
+ i-36774))
+ #f)
+ (let ((n-36921
+ (vector-ref
+ (vector-ref ribcage-36768 3)
+ i-36774)))
+ (if (pair? n-36921)
+ (if (equal? mod-36769 (car n-36921))
+ (values (cdr n-36921) marks-36766)
+ (f-36771 (#{1+}# i-36774)))
+ (values n-36921 marks-36766)))
+ (f-36771 (#{1+}# i-36774)))))))
+ (f-36771 0))))))
+ (if (symbol? id-36353)
+ (let ((t-36359
+ (search-36356
+ id-36353
+ (cdr w-36354)
+ (car w-36354)
+ mod-36355)))
+ (if t-36359 t-36359 id-36353))
+ (if (if (vector? id-36353)
+ (if (= (vector-length id-36353) 4)
+ (eq? (vector-ref id-36353 0) 'syntax-object)
#f)
#f)
- (let ((id-18179 (vector-ref id-18159 1))
- (w1-18180 (vector-ref id-18159 2)))
- (let ((marks-18181
- (let ((m1-18191 (car w-18160))
- (m2-18192 (car w1-18180)))
- (if (null? m2-18192)
- m1-18191
- (append m1-18191 m2-18192)))))
+ (let ((id-36374 (vector-ref id-36353 1))
+ (w1-36375 (vector-ref id-36353 2))
+ (mod-36376 (vector-ref id-36353 3)))
+ (let ((marks-36377
+ (let ((m1-36387 (car w-36354))
+ (m2-36388 (car w1-36375)))
+ (if (null? m2-36388)
+ m1-36387
+ (append m1-36387 m2-36388)))))
(call-with-values
(lambda ()
- (search-18161 id-18179 (cdr w-18160) marks-18181))
- (lambda (new-id-18208 marks-18209)
- (if new-id-18208
- new-id-18208
- (let ((t-18217
- (search-18161
- id-18179
- (cdr w1-18180)
- marks-18209)))
- (if t-18217 t-18217 id-18179)))))))
+ (search-36356
+ id-36374
+ (cdr w-36354)
+ marks-36377
+ mod-36376))
+ (lambda (new-id-36408 marks-36409)
+ (if new-id-36408
+ new-id-36408
+ (let ((t-36417
+ (search-36356
+ id-36374
+ (cdr w1-36375)
+ marks-36409
+ mod-36376)))
+ (if t-36417 t-36417 id-36374)))))))
(syntax-violation
'id-var-name
"invalid id"
- id-18159))))))
- (locally-bound-identifiers-6569
- (lambda (w-18300 mod-18301)
+ id-36353))))))
+ (locally-bound-identifiers-4570
+ (lambda (w-19391 mod-19392)
(letrec*
- ((scan-18302
- (lambda (subst-18307 results-18308)
- (if (null? subst-18307)
- results-18308
- (let ((fst-18309 (car subst-18307)))
- (if (eq? fst-18309 'shift)
- (scan-18302 (cdr subst-18307) results-18308)
- (let ((symnames-18311 (vector-ref fst-18309 1))
- (marks-18312 (vector-ref fst-18309 2)))
- (if (vector? symnames-18311)
- (scan-vector-rib-18304
- subst-18307
- symnames-18311
- marks-18312
- results-18308)
- (scan-list-rib-18303
- subst-18307
- symnames-18311
- marks-18312
- results-18308))))))))
- (scan-list-rib-18303
- (lambda (subst-18410
- symnames-18411
- marks-18412
- results-18413)
+ ((scan-19393
+ (lambda (subst-19398 results-19399)
+ (if (null? subst-19398)
+ results-19399
+ (let ((fst-19400 (car subst-19398)))
+ (if (eq? fst-19400 'shift)
+ (scan-19393 (cdr subst-19398) results-19399)
+ (let ((symnames-19402 (vector-ref fst-19400 1))
+ (marks-19403 (vector-ref fst-19400 2)))
+ (if (vector? symnames-19402)
+ (scan-vector-rib-19395
+ subst-19398
+ symnames-19402
+ marks-19403
+ results-19399)
+ (scan-list-rib-19394
+ subst-19398
+ symnames-19402
+ marks-19403
+ results-19399))))))))
+ (scan-list-rib-19394
+ (lambda (subst-19520
+ symnames-19521
+ marks-19522
+ results-19523)
(letrec*
- ((f-18414
- (lambda (symnames-18514 marks-18515 results-18516)
- (if (null? symnames-18514)
- (scan-18302 (cdr subst-18410) results-18516)
- (f-18414
- (cdr symnames-18514)
- (cdr marks-18515)
- (cons (wrap-6578
- (car symnames-18514)
- (let ((w-18524
- (cons (car marks-18515)
- subst-18410)))
- (cons (cons #f (car w-18524))
- (cons 'shift (cdr w-18524))))
- mod-18301)
- results-18516))))))
- (f-18414
- symnames-18411
- marks-18412
- results-18413))))
- (scan-vector-rib-18304
- (lambda (subst-18525
- symnames-18526
- marks-18527
- results-18528)
- (let ((n-18529 (vector-length symnames-18526)))
+ ((f-19524
+ (lambda (symnames-19709 marks-19710 results-19711)
+ (if (null? symnames-19709)
+ (scan-19393 (cdr subst-19520) results-19711)
+ (f-19524
+ (cdr symnames-19709)
+ (cdr marks-19710)
+ (cons (let ((x-19717 (car symnames-19709))
+ (w-19718
+ (let ((w-19722
+ (cons (car marks-19710)
+ subst-19520)))
+ (cons (cons #f (car w-19722))
+ (cons 'shift
+ (cdr w-19722))))))
+ (if (if (null? (car w-19718))
+ (null? (cdr w-19718))
+ #f)
+ x-19717
+ (if (if (vector? x-19717)
+ (if (= (vector-length x-19717) 4)
+ (eq? (vector-ref x-19717 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-19734
+ (vector-ref x-19717 1))
+ (wrap-19735
+ (let ((w2-19743
+ (vector-ref x-19717 2)))
+ (let ((m1-19744 (car w-19718))
+ (s1-19745
+ (cdr w-19718)))
+ (if (null? m1-19744)
+ (if (null? s1-19745)
+ w2-19743
+ (cons (car w2-19743)
+ (let ((m2-19756
+ (cdr w2-19743)))
+ (if (null? m2-19756)
+ s1-19745
+ (append
+ s1-19745
+ m2-19756)))))
+ (cons (let ((m2-19764
+ (car w2-19743)))
+ (if (null? m2-19764)
+ m1-19744
+ (append
+ m1-19744
+ m2-19764)))
+ (let ((m2-19772
+ (cdr w2-19743)))
+ (if (null? m2-19772)
+ s1-19745
+ (append
+ s1-19745
+ m2-19772))))))))
+ (module-19736
+ (vector-ref x-19717 3)))
+ (vector
+ 'syntax-object
+ expression-19734
+ wrap-19735
+ module-19736))
+ (if (null? x-19717)
+ x-19717
+ (vector
+ 'syntax-object
+ x-19717
+ w-19718
+ mod-19392)))))
+ results-19711))))))
+ (f-19524
+ symnames-19521
+ marks-19522
+ results-19523))))
+ (scan-vector-rib-19395
+ (lambda (subst-19785
+ symnames-19786
+ marks-19787
+ results-19788)
+ (let ((n-19789 (vector-length symnames-19786)))
(letrec*
- ((f-18530
- (lambda (i-18613 results-18614)
- (if (= i-18613 n-18529)
- (scan-18302 (cdr subst-18525) results-18614)
- (f-18530
- (#{1+}# i-18613)
- (cons (wrap-6578
- (vector-ref symnames-18526 i-18613)
- (let ((w-18622
- (cons (vector-ref
- marks-18527
- i-18613)
- subst-18525)))
- (cons (cons #f (car w-18622))
- (cons 'shift (cdr w-18622))))
- mod-18301)
- results-18614))))))
- (f-18530 0 results-18528))))))
- (scan-18302 (cdr w-18300) '()))))
- (valid-bound-ids?-6575
- (lambda (ids-18623)
+ ((f-19790
+ (lambda (i-19961 results-19962)
+ (if (= i-19961 n-19789)
+ (scan-19393 (cdr subst-19785) results-19962)
+ (f-19790
+ (#{1+}# i-19961)
+ (cons (let ((x-19968
+ (vector-ref symnames-19786 i-19961))
+ (w-19969
+ (let ((w-19973
+ (cons (vector-ref
+ marks-19787
+ i-19961)
+ subst-19785)))
+ (cons (cons #f (car w-19973))
+ (cons 'shift
+ (cdr w-19973))))))
+ (if (if (null? (car w-19969))
+ (null? (cdr w-19969))
+ #f)
+ x-19968
+ (if (if (vector? x-19968)
+ (if (= (vector-length x-19968) 4)
+ (eq? (vector-ref x-19968 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-19985
+ (vector-ref x-19968 1))
+ (wrap-19986
+ (let ((w2-19994
+ (vector-ref
+ x-19968
+ 2)))
+ (let ((m1-19995
+ (car w-19969))
+ (s1-19996
+ (cdr w-19969)))
+ (if (null? m1-19995)
+ (if (null? s1-19996)
+ w2-19994
+ (cons (car w2-19994)
+ (let ((m2-20007
+ (cdr w2-19994)))
+ (if (null? m2-20007)
+ s1-19996
+ (append
+ s1-19996
+ m2-20007)))))
+ (cons (let ((m2-20015
+ (car w2-19994)))
+ (if (null? m2-20015)
+ m1-19995
+ (append
+ m1-19995
+ m2-20015)))
+ (let ((m2-20023
+ (cdr w2-19994)))
+ (if (null? m2-20023)
+ s1-19996
+ (append
+ s1-19996
+ m2-20023))))))))
+ (module-19987
+ (vector-ref x-19968 3)))
+ (vector
+ 'syntax-object
+ expression-19985
+ wrap-19986
+ module-19987))
+ (if (null? x-19968)
+ x-19968
+ (vector
+ 'syntax-object
+ x-19968
+ w-19969
+ mod-19392)))))
+ results-19962))))))
+ (f-19790 0 results-19788))))))
+ (scan-19393 (cdr w-19391) '()))))
+ (resolve-identifier-4571
+ (lambda (id-20036
+ w-20037
+ r-20038
+ mod-20039
+ resolve-syntax-parameters?-20040)
+ (let ((n-20044
+ (id-var-name-4569 id-20036 w-20037 mod-20039)))
+ (if (if (vector? n-20044)
+ (if (= (vector-length n-20044) 4)
+ (eq? (vector-ref n-20044 0) 'syntax-object)
+ #f)
+ #f)
+ (resolve-identifier-4571
+ n-20044
+ w-20037
+ r-20038
+ mod-20039
+ resolve-syntax-parameters?-20040)
+ (if (symbol? n-20044)
+ (let ((mod-20059
+ (if (if (vector? id-20036)
+ (if (= (vector-length id-20036) 4)
+ (eq? (vector-ref id-20036 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref id-20036 3)
+ mod-20039)))
+ (let ((b-20060
+ (let ((b-20063
+ (let ((t-20064
+ (begin
+ (if (if (not mod-20059)
+ (current-module)
+ #f)
+ (warn "module system is booted, we should have a module"
+ n-20044))
+ (let ((v-20113
+ (module-variable
+ (if mod-20059
+ (resolve-module
+ (cdr mod-20059))
+ (current-module))
+ n-20044)))
+ (if v-20113
+ (if (variable-bound? v-20113)
+ (let ((val-20122
+ (variable-ref
+ v-20113)))
+ (if (macro? val-20122)
+ (if (macro-type val-20122)
+ (cons (macro-type
+ val-20122)
+ (macro-binding
+ val-20122))
+ #f)
+ #f))
+ #f)
+ #f)))))
+ (if t-20064 t-20064 '(global)))))
+ (if (if resolve-syntax-parameters?-20040
+ (eq? (car b-20063) 'syntax-parameter)
+ #f)
+ (let ((t-20131 (assq-ref r-20038 (cdr b-20063))))
+ (if t-20131
+ t-20131
+ (cons 'macro (car (cdr b-20063)))))
+ b-20063))))
+ (if (eq? (car b-20060) 'global)
+ (values 'global n-20044 mod-20059)
+ (values (car b-20060) (cdr b-20060) mod-20059))))
+ (if (string? n-20044)
+ (let ((mod-20137
+ (if (if (vector? id-20036)
+ (if (= (vector-length id-20036) 4)
+ (eq? (vector-ref id-20036 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref id-20036 3)
+ mod-20039)))
+ (let ((b-20138
+ (let ((b-20141
+ (let ((t-20142 (assq-ref r-20038 n-20044)))
+ (if t-20142
+ t-20142
+ '(displaced-lexical)))))
+ (if (if resolve-syntax-parameters?-20040
+ (eq? (car b-20141) 'syntax-parameter)
+ #f)
+ (let ((t-20143
+ (assq-ref r-20038 (cdr b-20141))))
+ (if t-20143
+ t-20143
+ (cons 'macro (car (cdr b-20141)))))
+ b-20141))))
+ (values (car b-20138) (cdr b-20138) mod-20137)))
+ (error "unexpected id-var-name"
+ id-20036
+ w-20037
+ n-20044)))))))
+ (free-id=?-4574
+ (lambda (i-20156 j-20157)
+ (let ((mi-20158
+ (if (if (vector? i-20156)
+ (if (= (vector-length i-20156) 4)
+ (eq? (vector-ref i-20156 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref i-20156 3)
+ #f)))
+ (let ((mj-20159
+ (if (if (vector? j-20157)
+ (if (= (vector-length j-20157) 4)
+ (eq? (vector-ref j-20157 0) 'syntax-object)
+ #f)
+ #f)
+ (vector-ref j-20157 3)
+ #f)))
+ (let ((ni-20160
+ (id-var-name-4569 i-20156 '(()) mi-20158)))
+ (let ((nj-20161
+ (id-var-name-4569 j-20157 '(()) mj-20159)))
+ (if (if (vector? ni-20160)
+ (if (= (vector-length ni-20160) 4)
+ (eq? (vector-ref ni-20160 0) 'syntax-object)
+ #f)
+ #f)
+ (free-id=?-4574 ni-20160 j-20157)
+ (if (if (vector? nj-20161)
+ (if (= (vector-length nj-20161) 4)
+ (eq? (vector-ref nj-20161 0) 'syntax-object)
+ #f)
+ #f)
+ (free-id=?-4574 i-20156 nj-20161)
+ (if (symbol? ni-20160)
+ (if (eq? nj-20161
+ (if (if (vector? j-20157)
+ (if (= (vector-length j-20157) 4)
+ (eq? (vector-ref j-20157 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref j-20157 1)
+ j-20157))
+ (if (let ((bi-20233
+ (module-variable
+ (if mi-20158
+ (resolve-module (cdr mi-20158))
+ (current-module))
+ (if (if (vector? i-20156)
+ (if (= (vector-length i-20156) 4)
+ (eq? (vector-ref i-20156 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref i-20156 1)
+ i-20156))))
+ (if bi-20233
+ (eq? bi-20233
+ (module-variable
+ (if mj-20159
+ (resolve-module (cdr mj-20159))
+ (current-module))
+ (if (if (vector? j-20157)
+ (if (= (vector-length j-20157) 4)
+ (eq? (vector-ref j-20157 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref j-20157 1)
+ j-20157)))
+ (if (not (module-variable
+ (if mj-20159
+ (resolve-module (cdr mj-20159))
+ (current-module))
+ (if (if (vector? j-20157)
+ (if (= (vector-length
+ j-20157)
+ 4)
+ (eq? (vector-ref j-20157 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref j-20157 1)
+ j-20157)))
+ (eq? ni-20160 nj-20161)
+ #f)))
+ (eq? (module-variable
+ (if mi-20158
+ (resolve-module (cdr mi-20158))
+ (current-module))
+ (if (if (vector? i-20156)
+ (if (= (vector-length i-20156) 4)
+ (eq? (vector-ref i-20156 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref i-20156 1)
+ i-20156))
+ (module-variable
+ (if mj-20159
+ (resolve-module (cdr mj-20159))
+ (current-module))
+ (if (if (vector? j-20157)
+ (if (= (vector-length j-20157) 4)
+ (eq? (vector-ref j-20157 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (vector-ref j-20157 1)
+ j-20157)))
+ #f)
+ #f)
+ (equal? ni-20160 nj-20161))))))))))
+ (bound-id=?-4575
+ (lambda (i-20426 j-20427)
+ (if (if (if (vector? i-20426)
+ (if (= (vector-length i-20426) 4)
+ (eq? (vector-ref i-20426 0) 'syntax-object)
+ #f)
+ #f)
+ (if (vector? j-20427)
+ (if (= (vector-length j-20427) 4)
+ (eq? (vector-ref j-20427 0) 'syntax-object)
+ #f)
+ #f)
+ #f)
+ (if (eq? (vector-ref i-20426 1)
+ (vector-ref j-20427 1))
+ (same-marks?-4568
+ (car (vector-ref i-20426 2))
+ (car (vector-ref j-20427 2)))
+ #f)
+ (eq? i-20426 j-20427))))
+ (valid-bound-ids?-4576
+ (lambda (ids-20596)
(if (letrec*
- ((all-ids?-18624
- (lambda (ids-18786)
- (if (null? ids-18786)
- (null? ids-18786)
- (if (let ((x-18797 (car ids-18786)))
- (if (symbol? x-18797)
+ ((all-ids?-20597
+ (lambda (ids-20794)
+ (if (null? ids-20794)
+ (null? ids-20794)
+ (if (let ((x-20805 (car ids-20794)))
+ (if (symbol? x-20805)
#t
- (if (if (vector? x-18797)
- (if (= (vector-length x-18797) 4)
- (eq? (vector-ref x-18797 0)
+ (if (if (vector? x-20805)
+ (if (= (vector-length x-20805) 4)
+ (eq? (vector-ref x-20805 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-18797 1))
+ (symbol? (vector-ref x-20805 1))
#f)))
- (all-ids?-18624 (cdr ids-18786))
+ (all-ids?-20597 (cdr ids-20794))
#f)))))
- (all-ids?-18624 ids-18623))
- (distinct-bound-ids?-6576 ids-18623)
+ (all-ids?-20597 ids-20596))
+ (distinct-bound-ids?-4577 ids-20596)
#f)))
- (distinct-bound-ids?-6576
- (lambda (ids-18925)
+ (distinct-bound-ids?-4577
+ (lambda (ids-20926)
(letrec*
- ((distinct?-18926
- (lambda (ids-19038)
- (if (null? ids-19038)
- (null? ids-19038)
- (if (not (bound-id-member?-6577
- (car ids-19038)
- (cdr ids-19038)))
- (distinct?-18926 (cdr ids-19038))
+ ((distinct?-20927
+ (lambda (ids-21032)
+ (if (null? ids-21032)
+ (null? ids-21032)
+ (if (not (bound-id-member?-4578
+ (car ids-21032)
+ (cdr ids-21032)))
+ (distinct?-20927 (cdr ids-21032))
#f)))))
- (distinct?-18926 ids-18925))))
- (bound-id-member?-6577
- (lambda (x-19248 list-19249)
- (if (not (null? list-19249))
- (let ((t-19250
- (let ((j-19331 (car list-19249)))
- (if (if (if (vector? x-19248)
- (if (= (vector-length x-19248) 4)
- (eq? (vector-ref x-19248 0) 'syntax-object)
- #f)
- #f)
- (if (vector? j-19331)
- (if (= (vector-length j-19331) 4)
- (eq? (vector-ref j-19331 0) 'syntax-object)
- #f)
- #f)
- #f)
- (if (eq? (vector-ref x-19248 1)
- (vector-ref j-19331 1))
- (same-marks?-6567
- (car (vector-ref x-19248 2))
- (car (vector-ref j-19331 2)))
- #f)
- (eq? x-19248 j-19331)))))
- (if t-19250
- t-19250
- (bound-id-member?-6577 x-19248 (cdr list-19249))))
+ (distinct?-20927 ids-20926))))
+ (bound-id-member?-4578
+ (lambda (x-21128 list-21129)
+ (if (not (null? list-21129))
+ (let ((t-21130
+ (bound-id=?-4575 x-21128 (car list-21129))))
+ (if t-21130
+ t-21130
+ (bound-id-member?-4578 x-21128 (cdr list-21129))))
#f)))
- (wrap-6578
- (lambda (x-19375 w-19376 defmod-19377)
- (if (if (null? (car w-19376))
- (null? (cdr w-19376))
- #f)
- x-19375
- (if (if (vector? x-19375)
- (if (= (vector-length x-19375) 4)
- (eq? (vector-ref x-19375 0) 'syntax-object)
- #f)
+ (source-wrap-4580
+ (lambda (x-21308 w-21309 s-21310 defmod-21311)
+ (let ((x-21315
+ (begin
+ (if (if (pair? x-21308) s-21310 #f)
+ (set-source-properties! x-21308 s-21310))
+ x-21308)))
+ (if (if (null? (car w-21309))
+ (null? (cdr w-21309))
#f)
- (let ((expression-19391 (vector-ref x-19375 1))
- (wrap-19392
- (join-wraps-6565 w-19376 (vector-ref x-19375 2)))
- (module-19393 (vector-ref x-19375 3)))
- (vector
- 'syntax-object
- expression-19391
- wrap-19392
- module-19393))
- (if (null? x-19375)
- x-19375
- (vector
- 'syntax-object
- x-19375
- w-19376
- defmod-19377))))))
- (source-wrap-6579
- (lambda (x-19410 w-19411 s-19412 defmod-19413)
- (wrap-6578
- (begin
- (if (if (pair? x-19410) s-19412 #f)
- (set-source-properties! x-19410 s-19412))
- x-19410)
- w-19411
- defmod-19413)))
- (expand-sequence-6580
- (lambda (body-29409 r-29410 w-29411 s-29412 mod-29413)
- (build-sequence-6530
- s-29412
+ x-21315
+ (if (if (vector? x-21315)
+ (if (= (vector-length x-21315) 4)
+ (eq? (vector-ref x-21315 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-21347 (vector-ref x-21315 1))
+ (wrap-21348
+ (let ((w2-21356 (vector-ref x-21315 2)))
+ (let ((m1-21357 (car w-21309))
+ (s1-21358 (cdr w-21309)))
+ (if (null? m1-21357)
+ (if (null? s1-21358)
+ w2-21356
+ (cons (car w2-21356)
+ (let ((m2-21373 (cdr w2-21356)))
+ (if (null? m2-21373)
+ s1-21358
+ (append s1-21358 m2-21373)))))
+ (cons (let ((m2-21381 (car w2-21356)))
+ (if (null? m2-21381)
+ m1-21357
+ (append m1-21357 m2-21381)))
+ (let ((m2-21389 (cdr w2-21356)))
+ (if (null? m2-21389)
+ s1-21358
+ (append s1-21358 m2-21389))))))))
+ (module-21349 (vector-ref x-21315 3)))
+ (vector
+ 'syntax-object
+ expression-21347
+ wrap-21348
+ module-21349))
+ (if (null? x-21315)
+ x-21315
+ (vector
+ 'syntax-object
+ x-21315
+ w-21309
+ defmod-21311)))))))
+ (expand-sequence-4581
+ (lambda (body-36926 r-36927 w-36928 s-36929 mod-36930)
+ (build-sequence-4532
+ s-36929
(letrec*
- ((dobody-29493
- (lambda (body-29833 r-29834 w-29835 mod-29836)
- (if (null? body-29833)
+ ((dobody-37018
+ (lambda (body-37101 r-37102 w-37103 mod-37104)
+ (if (null? body-37101)
'()
- (let ((first-29837
- (let ((e-29841 (car body-29833)))
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-29841
- r-29834
- w-29835
- (source-annotation-6542 e-29841)
- #f
- mod-29836
- #f))
- (lambda (type-29848
- value-29849
- form-29850
- e-29851
- w-29852
- s-29853
- mod-29854)
- (expand-expr-6586
- type-29848
- value-29849
- form-29850
- e-29851
- r-29834
- w-29852
- s-29853
- mod-29854))))))
- (cons first-29837
- (dobody-29493
- (cdr body-29833)
- r-29834
- w-29835
- mod-29836)))))))
- (dobody-29493
- body-29409
- r-29410
- w-29411
- mod-29413)))))
- (expand-top-sequence-6581
- (lambda (body-19431
- r-19432
- w-19433
- s-19434
- m-19435
- esew-19436
- mod-19437)
- (letrec*
- ((scan-19438
- (lambda (body-19569
- r-19570
- w-19571
- s-19572
- m-19573
- esew-19574
- mod-19575
- exps-19576)
- (if (null? body-19569)
- exps-19576
- (call-with-values
- (lambda ()
+ (let ((first-37105
+ (expand-4586
+ (car body-37101)
+ r-37102
+ w-37103
+ mod-37104)))
+ (cons first-37105
+ (dobody-37018
+ (cdr body-37101)
+ r-37102
+ w-37103
+ mod-37104)))))))
+ (dobody-37018
+ body-36926
+ r-36927
+ w-36928
+ mod-36930)))))
+ (expand-top-sequence-4582
+ (lambda (body-21418
+ r-21419
+ w-21420
+ s-21421
+ m-21422
+ esew-21423
+ mod-21424)
+ (let ((r-21425
+ (cons '("placeholder" placeholder) r-21419)))
+ (let ((ribcage-21426 (vector 'ribcage '() '() '())))
+ (let ((w-21427
+ (cons (car w-21420)
+ (cons ribcage-21426 (cdr w-21420)))))
+ (letrec*
+ ((record-definition!-21428
+ (lambda (id-24805 var-24806)
+ (let ((mod-24807
+ (cons 'hygiene (module-name (current-module)))))
+ (let ((label-24813
+ (cons (vector-ref id-24805 3)
+ (if (if (vector? var-24806)
+ (if (= (vector-length var-24806) 4)
+ (eq? (vector-ref var-24806 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-24875
+ (vector-ref var-24806 1))
+ (wrap-24876
+ (let ((w2-24886
+ (vector-ref
+ var-24806
+ 2)))
+ (cons (let ((m2-24893
+ (car w2-24886)))
+ (if (null? m2-24893)
+ '(top)
+ (append
+ '(top)
+ m2-24893)))
+ (let ((m2-24902
+ (cdr w2-24886)))
+ (if (null? m2-24902)
+ '()
+ (append
+ '()
+ m2-24902))))))
+ (module-24877
+ (vector-ref var-24806 3)))
+ (vector
+ 'syntax-object
+ expression-24875
+ wrap-24876
+ module-24877))
+ (if (null? var-24806)
+ var-24806
+ (vector
+ 'syntax-object
+ var-24806
+ '((top))
+ mod-24807))))))
+ (begin
+ (let ((update-24816
+ (cons (vector-ref id-24805 1)
+ (vector-ref ribcage-21426 1))))
+ (vector-set! ribcage-21426 1 update-24816))
+ (let ((update-24831
+ (cons (car (vector-ref id-24805 2))
+ (vector-ref ribcage-21426 2))))
+ (vector-set! ribcage-21426 2 update-24831))
+ (let ((update-24846
+ (cons label-24813
+ (vector-ref ribcage-21426 3))))
+ (vector-set! ribcage-21426 3 update-24846)))))))
+ (parse-21431
+ (lambda (body-21626
+ r-21627
+ w-21628
+ s-21629
+ m-21630
+ esew-21631
+ mod-21632)
+ (letrec*
+ ((lp-21633
+ (lambda (body-21716 exps-21717)
+ (if (null? body-21716)
+ exps-21717
+ (lp-21633
+ (cdr body-21716)
+ (append
+ (parse1-21432
+ (car body-21716)
+ r-21627
+ w-21628
+ s-21629
+ m-21630
+ esew-21631
+ mod-21632)
+ exps-21717))))))
+ (lp-21633 body-21626 '()))))
+ (parse1-21432
+ (lambda (x-21787
+ r-21788
+ w-21789
+ s-21790
+ m-21791
+ esew-21792
+ mod-21793)
(call-with-values
(lambda ()
- (let ((e-19577 (car body-19569)))
- (syntax-type-6584
- e-19577
- r-19570
- w-19571
- (let ((t-19581 (source-annotation-6542 e-19577)))
- (if t-19581 t-19581 s-19572))
- #f
- mod-19575
- #f)))
- (lambda (type-19816
- value-19817
- form-19818
- e-19819
- w-19820
- s-19821
- mod-19822)
- (if (eqv? type-19816 'begin-form)
- (let ((tmp-19827 ($sc-dispatch e-19819 '(_))))
- (if tmp-19827
- (@apply (lambda () exps-19576) tmp-19827)
- (let ((tmp-19831
- ($sc-dispatch
- e-19819
- '(_ any . each-any))))
- (if tmp-19831
- (@apply
- (lambda (e1-19835 e2-19836)
- (scan-19438
- (cons e1-19835 e2-19836)
- r-19570
- w-19820
- s-19821
- m-19573
- esew-19574
- mod-19822
- exps-19576))
- tmp-19831)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-19819)))))
- (if (eqv? type-19816 'local-syntax-form)
- (expand-local-syntax-6590
- value-19817
- e-19819
- r-19570
- w-19820
- s-19821
- mod-19822
- (lambda (body-19851
- r-19852
- w-19853
- s-19854
- mod-19855)
- (scan-19438
- body-19851
- r-19852
- w-19853
- s-19854
- m-19573
- esew-19574
- mod-19855
- exps-19576)))
- (if (eqv? type-19816 'eval-when-form)
- (let ((tmp-19860
+ (syntax-type-4585
+ x-21787
+ r-21788
+ w-21789
+ (source-annotation-4544 x-21787)
+ ribcage-21426
+ mod-21793
+ #f))
+ (lambda (type-21979
+ value-21980
+ form-21981
+ e-21982
+ w-21983
+ s-21984
+ mod-21985)
+ (if (eqv? type-21979 'define-form)
+ (let ((id-21989
+ (if (if (null? (car w-21983))
+ (null? (cdr w-21983))
+ #f)
+ value-21980
+ (if (if (vector? value-21980)
+ (if (= (vector-length value-21980)
+ 4)
+ (eq? (vector-ref value-21980 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-22039
+ (vector-ref value-21980 1))
+ (wrap-22040
+ (let ((w2-22050
+ (vector-ref
+ value-21980
+ 2)))
+ (let ((m1-22051
+ (car w-21983))
+ (s1-22052
+ (cdr w-21983)))
+ (if (null? m1-22051)
+ (if (null? s1-22052)
+ w2-22050
+ (cons (car w2-22050)
+ (let ((m2-22069
+ (cdr w2-22050)))
+ (if (null? m2-22069)
+ s1-22052
+ (append
+ s1-22052
+ m2-22069)))))
+ (cons (let ((m2-22077
+ (car w2-22050)))
+ (if (null? m2-22077)
+ m1-22051
+ (append
+ m1-22051
+ m2-22077)))
+ (let ((m2-22085
+ (cdr w2-22050)))
+ (if (null? m2-22085)
+ s1-22052
+ (append
+ s1-22052
+ m2-22085))))))))
+ (module-22041
+ (vector-ref value-21980 3)))
+ (vector
+ 'syntax-object
+ expression-22039
+ wrap-22040
+ module-22041))
+ (if (null? value-21980)
+ value-21980
+ (vector
+ 'syntax-object
+ value-21980
+ w-21983
+ mod-21985))))))
+ (begin
+ (string-append
+ "l-"
+ (session-id-4511)
+ (symbol->string (gensym "-")))
+ (let ((var-21991
+ (if (not (equal?
+ (car (vector-ref
+ id-21989
+ 2))
+ '(top)))
+ (symbol-append
+ (vector-ref id-21989 1)
+ '-
+ (string->symbol
+ (number->string
+ (hash (syntax->datum x-21787)
+ most-positive-fixnum)
+ 16)))
+ (vector-ref id-21989 1))))
+ (begin
+ (record-definition!-21428
+ id-21989
+ var-21991)
+ (list (if (eq? m-21791 'c&e)
+ (let ((x-22211
+ (build-global-definition-4525
+ s-21984
+ var-21991
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985))))
+ (begin
+ (top-level-eval-hook-4509
+ x-22211
+ mod-21985)
+ (lambda () x-22211)))
+ (lambda ()
+ (build-global-definition-4525
+ s-21984
+ var-21991
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985)))))))))
+ (if (if (eqv? type-21979 'define-syntax-form)
+ #t
+ (eqv? type-21979
+ 'define-syntax-parameter-form))
+ (let ((id-22705
+ (if (if (null? (car w-21983))
+ (null? (cdr w-21983))
+ #f)
+ value-21980
+ (if (if (vector? value-21980)
+ (if (= (vector-length
+ value-21980)
+ 4)
+ (eq? (vector-ref value-21980 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-22755
+ (vector-ref value-21980 1))
+ (wrap-22756
+ (let ((w2-22766
+ (vector-ref
+ value-21980
+ 2)))
+ (let ((m1-22767
+ (car w-21983))
+ (s1-22768
+ (cdr w-21983)))
+ (if (null? m1-22767)
+ (if (null? s1-22768)
+ w2-22766
+ (cons (car w2-22766)
+ (let ((m2-22785
+ (cdr w2-22766)))
+ (if (null? m2-22785)
+ s1-22768
+ (append
+ s1-22768
+ m2-22785)))))
+ (cons (let ((m2-22793
+ (car w2-22766)))
+ (if (null? m2-22793)
+ m1-22767
+ (append
+ m1-22767
+ m2-22793)))
+ (let ((m2-22801
+ (cdr w2-22766)))
+ (if (null? m2-22801)
+ s1-22768
+ (append
+ s1-22768
+ m2-22801))))))))
+ (module-22757
+ (vector-ref value-21980 3)))
+ (vector
+ 'syntax-object
+ expression-22755
+ wrap-22756
+ module-22757))
+ (if (null? value-21980)
+ value-21980
+ (vector
+ 'syntax-object
+ value-21980
+ w-21983
+ mod-21985))))))
+ (begin
+ (string-append
+ "l-"
+ (session-id-4511)
+ (symbol->string (gensym "-")))
+ (let ((var-22707
+ (if (not (equal?
+ (car (vector-ref
+ id-22705
+ 2))
+ '(top)))
+ (symbol-append
+ (vector-ref id-22705 1)
+ '-
+ (string->symbol
+ (number->string
+ (hash (syntax->datum x-21787)
+ most-positive-fixnum)
+ 16)))
+ (vector-ref id-22705 1))))
+ (begin
+ (record-definition!-21428
+ id-22705
+ var-22707)
+ (if (eqv? m-21791 'c)
+ (if (memq 'compile esew-21792)
+ (let ((e-22930
+ (expand-install-global-4583
+ var-22707
+ type-21979
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985))))
+ (begin
+ (top-level-eval-hook-4509
+ e-22930
+ mod-21985)
+ (if (memq 'load esew-21792)
+ (list (lambda () e-22930))
+ '())))
+ (if (memq 'load esew-21792)
+ (list (lambda ()
+ (expand-install-global-4583
+ var-22707
+ type-21979
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985))))
+ '()))
+ (if (eqv? m-21791 'c&e)
+ (let ((e-23433
+ (expand-install-global-4583
+ var-22707
+ type-21979
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985))))
+ (begin
+ (top-level-eval-hook-4509
+ e-23433
+ mod-21985)
+ (list (lambda () e-23433))))
+ (begin
+ (if (memq 'eval esew-21792)
+ (top-level-eval-hook-4509
+ (expand-install-global-4583
+ var-22707
+ type-21979
+ (expand-4586
+ e-21982
+ r-21788
+ w-21983
+ mod-21985))
+ mod-21985))
+ '())))))))
+ (if (eqv? type-21979 'begin-form)
+ (let ((tmp-24043
($sc-dispatch
- e-19819
- '(_ each-any any . each-any))))
- (if tmp-19860
+ e-21982
+ '(_ . each-any))))
+ (if tmp-24043
(@apply
- (lambda (x-19864 e1-19865 e2-19866)
- (let ((when-list-19867
- (parse-when-list-6583
- e-19819
- x-19864))
- (body-19868
- (cons e1-19865 e2-19866)))
- (if (eq? m-19573 'e)
- (if (memq 'eval when-list-19867)
- (scan-19438
- body-19868
- r-19570
- w-19820
- s-19821
- (if (memq 'expand
- when-list-19867)
- 'c&e
- 'e)
- '(eval)
- mod-19822
- exps-19576)
- (begin
- (if (memq 'expand
- when-list-19867)
- (let ((x-19945
- (expand-top-sequence-6581
- body-19868
- r-19570
- w-19820
- s-19821
- 'e
- '(eval)
- mod-19822)))
- (primitive-eval x-19945)))
- exps-19576))
- (if (memq 'load when-list-19867)
- (if (let ((t-19971
- (memq 'compile
- when-list-19867)))
- (if t-19971
- t-19971
- (let ((t-20020
- (memq 'expand
- when-list-19867)))
- (if t-20020
- t-20020
- (if (eq? m-19573
- 'c&e)
- (memq 'eval
- when-list-19867)
- #f)))))
- (scan-19438
- body-19868
- r-19570
- w-19820
- s-19821
- 'c&e
- '(compile load)
- mod-19822
- exps-19576)
- (if (if (eq? m-19573 'c)
- #t
- (eq? m-19573 'c&e))
- (scan-19438
- body-19868
- r-19570
- w-19820
- s-19821
- 'c
- '(load)
- mod-19822
- exps-19576)
- exps-19576))
- (if (let ((t-20149
- (memq 'compile
- when-list-19867)))
- (if t-20149
- t-20149
- (let ((t-20198
- (memq 'expand
- when-list-19867)))
- (if t-20198
- t-20198
- (if (eq? m-19573
- 'c&e)
- (memq 'eval
- when-list-19867)
- #f)))))
- (begin
- (let ((x-20322
- (expand-top-sequence-6581
- body-19868
- r-19570
- w-19820
- s-19821
- 'e
- '(eval)
- mod-19822)))
- (primitive-eval x-20322))
- exps-19576)
- exps-19576)))))
- tmp-19860)
+ (lambda (e1-24047)
+ (parse-21431
+ e1-24047
+ r-21788
+ w-21983
+ s-21984
+ m-21791
+ esew-21792
+ mod-21985))
+ tmp-24043)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-19819)))
- (if (if (eqv? type-19816 'define-syntax-form)
- #t
- (eqv? type-19816
- 'define-syntax-parameter-form))
- (let ((n-20368
- (id-var-name-6568
- value-19817
- w-19820))
- (r-20369
- (macros-only-env-6545 r-19570)))
- (if (eqv? m-19573 'c)
- (if (memq 'compile esew-19574)
- (let ((e-20373
- (expand-install-global-6582
- n-20368
- (expand-6585
- e-19819
- r-20369
- w-19820
- mod-19822))))
- (begin
- (top-level-eval-hook-6508
- e-20373
- mod-19822)
- (if (memq 'load esew-19574)
- (cons e-20373 exps-19576)
- exps-19576)))
- (if (memq 'load esew-19574)
- (cons (expand-install-global-6582
- n-20368
- (expand-6585
- e-19819
- r-20369
- w-19820
- mod-19822))
- exps-19576)
- exps-19576))
- (if (eqv? m-19573 'c&e)
- (let ((e-21015
- (expand-install-global-6582
- n-20368
- (expand-6585
- e-19819
- r-20369
- w-19820
- mod-19822))))
- (begin
- (top-level-eval-hook-6508
- e-21015
- mod-19822)
- (cons e-21015 exps-19576)))
- (begin
- (if (memq 'eval esew-19574)
- (top-level-eval-hook-6508
- (expand-install-global-6582
- n-20368
- (expand-6585
- e-19819
- r-20369
- w-19820
- mod-19822))
- mod-19822))
- exps-19576))))
- (if (eqv? type-19816 'define-form)
- (let ((n-21689
- (id-var-name-6568
- value-19817
- w-19820)))
- (let ((type-21690
- (car (let ((t-21697
- (assq n-21689
- r-19570)))
- (if t-21697
- (cdr t-21697)
- (if (symbol? n-21689)
- (let ((t-21703
- (get-global-definition-hook-6512
- n-21689
- mod-19822)))
- (if t-21703
- t-21703
- '(global)))
- '(displaced-lexical)))))))
- (if (if (eqv? type-21690 'global)
- #t
- (if (eqv? type-21690 'core)
- #t
- (if (eqv? type-21690 'macro)
- #t
- (eqv? type-21690
- 'module-ref))))
- (begin
- (if (if (if (eq? m-19573 'c)
- #t
- (eq? m-19573 'c&e))
- (if (not (module-local-variable
- (current-module)
- n-21689))
- (current-module)
- #f)
- #f)
- (let ((old-21734
- (module-variable
- (current-module)
- n-21689)))
- (if (if (variable? old-21734)
- (variable-bound?
- old-21734)
- #f)
- (module-define!
- (current-module)
- n-21689
- (variable-ref old-21734))
- (module-add!
- (current-module)
- n-21689
- (make-undefined-variable)))))
- (cons (if (eq? m-19573 'c&e)
- (let ((x-22175
- (build-global-definition-6524
- s-19821
- n-21689
- (expand-6585
- e-19819
- r-19570
- w-19820
- mod-19822))))
+ e-21982)))
+ (if (eqv? type-21979 'local-syntax-form)
+ (expand-local-syntax-4591
+ value-21980
+ e-21982
+ r-21788
+ w-21983
+ s-21984
+ mod-21985
+ (lambda (forms-24090
+ r-24091
+ w-24092
+ s-24093
+ mod-24094)
+ (parse-21431
+ forms-24090
+ r-24091
+ w-24092
+ s-24093
+ m-21791
+ esew-21792
+ mod-24094)))
+ (if (eqv? type-21979 'eval-when-form)
+ (let ((tmp-24130
+ ($sc-dispatch
+ e-21982
+ '(_ each-any any . each-any))))
+ (if tmp-24130
+ (@apply
+ (lambda (x-24134 e1-24135 e2-24136)
+ (let ((when-list-24137
+ (parse-when-list-4584
+ e-21982
+ x-24134))
+ (body-24138
+ (cons e1-24135 e2-24136)))
+ (letrec*
+ ((recurse-24139
+ (lambda (m-24725 esew-24726)
+ (parse-21431
+ body-24138
+ r-21788
+ w-21983
+ s-21984
+ m-24725
+ esew-24726
+ mod-21985))))
+ (if (eq? m-21791 'e)
+ (if (memq 'eval
+ when-list-24137)
+ (recurse-24139
+ (if (memq 'expand
+ when-list-24137)
+ 'c&e
+ 'e)
+ '(eval))
+ (begin
+ (if (memq 'expand
+ when-list-24137)
+ (let ((x-24246
+ (expand-top-sequence-4582
+ body-24138
+ r-21788
+ w-21983
+ s-21984
+ 'e
+ '(eval)
+ mod-21985)))
+ (primitive-eval
+ x-24246)))
+ '()))
+ (if (memq 'load
+ when-list-24137)
+ (if (let ((t-24274
+ (memq 'compile
+ when-list-24137)))
+ (if t-24274
+ t-24274
+ (let ((t-24327
+ (memq 'expand
+ when-list-24137)))
+ (if t-24327
+ t-24327
+ (if (eq? m-21791
+ 'c&e)
+ (memq 'eval
+ when-list-24137)
+ #f)))))
+ (recurse-24139
+ 'c&e
+ '(compile load))
+ (if (if (eq? m-21791 'c)
+ #t
+ (eq? m-21791 'c&e))
+ (recurse-24139
+ 'c
+ '(load))
+ '()))
+ (if (let ((t-24536
+ (memq 'compile
+ when-list-24137)))
+ (if t-24536
+ t-24536
+ (let ((t-24589
+ (memq 'expand
+ when-list-24137)))
+ (if t-24589
+ t-24589
+ (if (eq? m-21791
+ 'c&e)
+ (memq 'eval
+ when-list-24137)
+ #f)))))
(begin
- (top-level-eval-hook-6508
- x-22175
- mod-19822)
- x-22175))
- (lambda ()
- (build-global-definition-6524
- s-19821
- n-21689
- (expand-6585
- e-19819
- r-19570
- w-19820
- mod-19822))))
- exps-19576))
- (if (eqv? type-21690
- 'displaced-lexical)
- (syntax-violation
- #f
- "identifier out of context"
- (wrap-6578
- (begin
- (if (if (pair? form-19818)
- s-19821
- #f)
- (set-source-properties!
- form-19818
- s-19821))
- form-19818)
- w-19820
- mod-19822)
- (wrap-6578
- value-19817
- w-19820
- mod-19822))
- (syntax-violation
- #f
- "cannot define keyword at top level"
- (wrap-6578
- (begin
- (if (if (pair? form-19818)
- s-19821
- #f)
- (set-source-properties!
- form-19818
- s-19821))
- form-19818)
- w-19820
- mod-19822)
- (wrap-6578
- value-19817
- w-19820
- mod-19822))))))
- (cons (if (eq? m-19573 'c&e)
- (let ((x-22674
- (expand-expr-6586
- type-19816
- value-19817
- form-19818
- e-19819
- r-19570
- w-19820
- s-19821
- mod-19822)))
+ (let ((x-24723
+ (expand-top-sequence-4582
+ body-24138
+ r-21788
+ w-21983
+ s-21984
+ 'e
+ '(eval)
+ mod-21985)))
+ (primitive-eval
+ x-24723))
+ '())
+ '()))))))
+ tmp-24130)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ e-21982)))
+ (list (if (eq? m-21791 'c&e)
+ (let ((x-24796
+ (expand-expr-4587
+ type-21979
+ value-21980
+ form-21981
+ e-21982
+ r-21788
+ w-21983
+ s-21984
+ mod-21985)))
(begin
- (primitive-eval x-22674)
- x-22674))
+ (primitive-eval x-24796)
+ (lambda () x-24796)))
(lambda ()
- (expand-expr-6586
- type-19816
- value-19817
- form-19818
- e-19819
- r-19570
- w-19820
- s-19821
- mod-19822)))
- exps-19576)))))))))
- (lambda (exps-22679)
- (scan-19438
- (cdr body-19569)
- r-19570
- w-19571
- s-19572
- m-19573
- esew-19574
- mod-19575
- exps-22679)))))))
- (call-with-values
- (lambda ()
- (scan-19438
- body-19431
- r-19432
- w-19433
- s-19434
- m-19435
- esew-19436
- mod-19437
- '()))
- (lambda (exps-19441)
- (if (null? exps-19441)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 0)
- s-19434)
- (build-sequence-6530
- s-19434
- (letrec*
- ((lp-19481
- (lambda (in-19565 out-19566)
- (if (null? in-19565)
- out-19566
- (let ((e-19567 (car in-19565)))
- (lp-19481
- (cdr in-19565)
- (cons (if (procedure? e-19567)
- (e-19567)
- e-19567)
- out-19566)))))))
- (lp-19481 exps-19441 '())))))))))
- (expand-install-global-6582
- (lambda (name-22680 e-22681)
- (let ((exp-22687
- (let ((fun-exp-22697
- (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-22698
- (list (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- name-22680)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 1)
- #f
- 'macro)
- e-22681)))
+ (expand-expr-4587
+ type-21979
+ value-21980
+ form-21981
+ e-21982
+ r-21788
+ w-21983
+ s-21984
+ mod-21985))))))))))))))
+ (let ((exps-21433
+ (map (lambda (x-21556) (x-21556))
+ (reverse
+ (parse-21431
+ body-21418
+ r-21425
+ w-21427
+ s-21421
+ m-21422
+ esew-21423
+ mod-21424)))))
+ (if (null? exps-21433)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 0)
+ s-21421)
+ (build-sequence-4532 s-21421 exps-21433)))))))))
+ (expand-install-global-4583
+ (lambda (name-24924 type-24925 e-24926)
+ (let ((exp-24932
+ (let ((args-24943
+ (if (eq? type-24925 'define-syntax-parameter-form)
+ (list (make-struct/no-tail
+ (vector-ref %expanded-vtables 1)
+ #f
+ name-24924)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 1)
+ #f
+ 'syntax-parameter)
+ (let ((args-24966 (list e-24926)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 12)
+ #f
+ 'list
+ args-24966)))
+ (list (make-struct/no-tail
+ (vector-ref %expanded-vtables 1)
+ #f
+ name-24924)
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 1)
+ #f
+ 'macro)
+ e-24926))))
(make-struct/no-tail
- (vector-ref %expanded-vtables 11)
+ (vector-ref %expanded-vtables 12)
#f
- fun-exp-22697
- arg-exps-22698))))
+ 'make-syntax-transformer
+ args-24943))))
(begin
- (if (if (struct? exp-22687)
- (eq? (struct-vtable exp-22687)
- (vector-ref %expanded-vtables 13))
+ (if (if (struct? exp-24932)
+ (eq? (struct-vtable exp-24932)
+ (vector-ref %expanded-vtables 14))
#f)
- (let ((meta-22739 (struct-ref exp-22687 1)))
- (if (not (assq 'name meta-22739))
- (let ((v-22746
- (cons (cons 'name name-22680) meta-22739)))
- (struct-set! exp-22687 1 v-22746)))))
+ (let ((meta-24993 (struct-ref exp-24932 1)))
+ (if (not (assq 'name meta-24993))
+ (let ((v-25000
+ (cons (cons 'name name-24924) meta-24993)))
+ (struct-set! exp-24932 1 v-25000)))))
(make-struct/no-tail
(vector-ref %expanded-vtables 9)
#f
- name-22680
- exp-22687)))))
- (parse-when-list-6583
- (lambda (e-22757 when-list-22758)
- (let ((result-22759 (strip-6598 when-list-22758 '(()))))
+ name-24924
+ exp-24932)))))
+ (parse-when-list-4584
+ (lambda (e-25011 when-list-25012)
+ (let ((result-25013 (strip-4599 when-list-25012 '(()))))
(letrec*
- ((lp-22760
- (lambda (l-22814)
- (if (null? l-22814)
- result-22759
- (if (let ((t-22816 (car l-22814)))
- (if (eq? t-22816 'compile)
+ ((lp-25014
+ (lambda (l-25080)
+ (if (null? l-25080)
+ result-25013
+ (if (let ((t-25082 (car l-25080)))
+ (if (eq? t-25082 'compile)
#t
- (if (eq? t-22816 'load)
+ (if (eq? t-25082 'load)
#t
- (if (eq? t-22816 'eval)
+ (if (eq? t-25082 'eval)
#t
- (eq? t-22816 'expand)))))
- (lp-22760 (cdr l-22814))
+ (eq? t-25082 'expand)))))
+ (lp-25014 (cdr l-25080))
(syntax-violation
'eval-when
"invalid situation"
- e-22757
- (car l-22814)))))))
- (lp-22760 result-22759)))))
- (syntax-type-6584
- (lambda (e-22818
- r-22819
- w-22820
- s-22821
- rib-22822
- mod-22823
- for-car?-22824)
- (if (symbol? e-22818)
- (let ((n-22825 (id-var-name-6568 e-22818 w-22820)))
- (let ((b-22826
- (let ((t-22834 (assq n-22825 r-22819)))
- (if t-22834
- (cdr t-22834)
- (if (symbol? n-22825)
- (let ((t-22840
- (get-global-definition-hook-6512
- n-22825
- mod-22823)))
- (if t-22840 t-22840 '(global)))
- '(displaced-lexical))))))
- (let ((type-22827 (car b-22826)))
- (if (eqv? type-22827 'lexical)
+ e-25011
+ (car l-25080)))))))
+ (lp-25014 result-25013)))))
+ (syntax-type-4585
+ (lambda (e-25084
+ r-25085
+ w-25086
+ s-25087
+ rib-25088
+ mod-25089
+ for-car?-25090)
+ (if (symbol? e-25084)
+ (call-with-values
+ (lambda ()
+ (resolve-identifier-4571
+ e-25084
+ w-25086
+ r-25085
+ mod-25089
+ #t))
+ (lambda (type-25093 value-25094 mod*-25095)
+ (if (eqv? type-25093 'macro)
+ (if for-car?-25090
(values
- type-22827
- (cdr b-22826)
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? type-22827 'global)
- (values
- type-22827
- n-22825
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? type-22827 'macro)
- (if for-car?-22824
- (values
- type-22827
- (cdr b-22826)
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (syntax-type-6584
- (expand-macro-6588
- (cdr b-22826)
- e-22818
- r-22819
- w-22820
- s-22821
- rib-22822
- mod-22823)
- r-22819
- '(())
- s-22821
- rib-22822
- mod-22823
- #f))
- (values
- type-22827
- (cdr b-22826)
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)))))))
- (if (pair? e-22818)
- (let ((first-22860 (car e-22818)))
+ type-25093
+ value-25094
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (syntax-type-4585
+ (expand-macro-4589
+ value-25094
+ e-25084
+ r-25085
+ w-25086
+ s-25087
+ rib-25088
+ mod-25089)
+ r-25085
+ '(())
+ s-25087
+ rib-25088
+ mod-25089
+ #f))
+ (if (eqv? type-25093 'global)
+ (values
+ type-25093
+ value-25094
+ e-25084
+ value-25094
+ w-25086
+ s-25087
+ mod*-25095)
+ (values
+ type-25093
+ value-25094
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)))))
+ (if (pair? e-25084)
+ (let ((first-25104 (car e-25084)))
(call-with-values
(lambda ()
- (syntax-type-6584
- first-22860
- r-22819
- w-22820
- s-22821
- rib-22822
- mod-22823
+ (syntax-type-4585
+ first-25104
+ r-25085
+ w-25086
+ s-25087
+ rib-25088
+ mod-25089
#t))
- (lambda (ftype-22862
- fval-22863
- fform-22864
- fe-22865
- fw-22866
- fs-22867
- fmod-22868)
- (if (eqv? ftype-22862 'lexical)
+ (lambda (ftype-25106
+ fval-25107
+ fform-25108
+ fe-25109
+ fw-25110
+ fs-25111
+ fmod-25112)
+ (if (eqv? ftype-25106 'lexical)
(values
'lexical-call
- fval-22863
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'global)
+ fval-25107
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'global)
(values
'global-call
(vector
'syntax-object
- fval-22863
- w-22820
- fmod-22868)
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'macro)
- (syntax-type-6584
- (expand-macro-6588
- fval-22863
- e-22818
- r-22819
- w-22820
- s-22821
- rib-22822
- mod-22823)
- r-22819
+ fval-25107
+ w-25086
+ fmod-25112)
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'macro)
+ (syntax-type-4585
+ (expand-macro-4589
+ fval-25107
+ e-25084
+ r-25085
+ w-25086
+ s-25087
+ rib-25088
+ mod-25089)
+ r-25085
'(())
- s-22821
- rib-22822
- mod-22823
- for-car?-22824)
- (if (eqv? ftype-22862 'module-ref)
+ s-25087
+ rib-25088
+ mod-25089
+ for-car?-25090)
+ (if (eqv? ftype-25106 'module-ref)
(call-with-values
- (lambda () (fval-22863 e-22818 r-22819 w-22820))
- (lambda (e-22889
- r-22890
- w-22891
- s-22892
- mod-22893)
- (syntax-type-6584
- e-22889
- r-22890
- w-22891
- s-22892
- rib-22822
- mod-22893
- for-car?-22824)))
- (if (eqv? ftype-22862 'core)
+ (lambda () (fval-25107 e-25084 r-25085 w-25086))
+ (lambda (e-25133
+ r-25134
+ w-25135
+ s-25136
+ mod-25137)
+ (syntax-type-4585
+ e-25133
+ r-25134
+ w-25135
+ s-25136
+ rib-25088
+ mod-25137
+ for-car?-25090)))
+ (if (eqv? ftype-25106 'core)
(values
'core-form
- fval-22863
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'local-syntax)
+ fval-25107
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'local-syntax)
(values
'local-syntax-form
- fval-22863
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'begin)
+ fval-25107
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'begin)
(values
'begin-form
#f
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'eval-when)
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'eval-when)
(values
'eval-when-form
#f
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
- (if (eqv? ftype-22862 'define)
- (let ((tmp-22910
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
+ (if (eqv? ftype-25106 'define)
+ (let ((tmp-25154
($sc-dispatch
- e-22818
+ e-25084
'(_ any any))))
- (if (if tmp-22910
+ (if (if tmp-25154
(@apply
- (lambda (name-22914 val-22915)
- (if (symbol? name-22914)
+ (lambda (name-25158 val-25159)
+ (if (symbol? name-25158)
#t
- (if (if (vector? name-22914)
+ (if (if (vector? name-25158)
(if (= (vector-length
- name-22914)
+ name-25158)
4)
(eq? (vector-ref
- name-22914
+ name-25158
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-22914
+ name-25158
1))
#f)))
- tmp-22910)
+ tmp-25154)
#f)
(@apply
- (lambda (name-22942 val-22943)
+ (lambda (name-25186 val-25187)
(values
'define-form
- name-22942
- e-22818
- val-22943
- w-22820
- s-22821
- mod-22823))
- tmp-22910)
- (let ((tmp-22944
+ name-25186
+ e-25084
+ val-25187
+ w-25086
+ s-25087
+ mod-25089))
+ tmp-25154)
+ (let ((tmp-25188
($sc-dispatch
- e-22818
+ e-25084
'(_ (any . any)
any
.
each-any))))
- (if (if tmp-22944
+ (if (if tmp-25188
(@apply
- (lambda (name-22948
- args-22949
- e1-22950
- e2-22951)
+ (lambda (name-25192
+ args-25193
+ e1-25194
+ e2-25195)
(if (if (symbol?
- name-22948)
+ name-25192)
#t
(if (if (vector?
- name-22948)
+ name-25192)
(if (= (vector-length
- name-22948)
+ name-25192)
4)
(eq? (vector-ref
- name-22948
+ name-25192
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-22948
+ name-25192
1))
#f))
- (valid-bound-ids?-6575
- (letrec*
- ((lvl-23100
- (lambda (vars-23102
- ls-23103
- w-23104)
- (if (pair? vars-23102)
- (lvl-23100
- (cdr vars-23102)
- (cons (wrap-6578
- (car vars-23102)
- w-23104
- #f)
- ls-23103)
- w-23104)
- (if (if (symbol?
- vars-23102)
- #t
- (if (if (vector?
- vars-23102)
- (if (= (vector-length
- vars-23102)
- 4)
- (eq? (vector-ref
- vars-23102
- 0)
- 'syntax-object)
- #f)
- #f)
- (symbol?
- (vector-ref
- vars-23102
- 1))
- #f))
- (cons (wrap-6578
- vars-23102
- w-23104
- #f)
- ls-23103)
- (if (null? vars-23102)
- ls-23103
- (if (if (vector?
- vars-23102)
- (if (= (vector-length
- vars-23102)
- 4)
- (eq? (vector-ref
- vars-23102
- 0)
- 'syntax-object)
- #f)
- #f)
- (lvl-23100
- (vector-ref
- vars-23102
- 1)
- ls-23103
- (join-wraps-6565
- w-23104
- (vector-ref
- vars-23102
- 2)))
- (cons vars-23102
- ls-23103))))))))
- (lvl-23100
- args-22949
- '()
- '(()))))
+ (valid-bound-ids?-4576
+ (lambda-var-list-4601
+ args-25193))
#f))
- tmp-22944)
+ tmp-25188)
#f)
(@apply
- (lambda (name-23148
- args-23149
- e1-23150
- e2-23151)
+ (lambda (name-25658
+ args-25659
+ e1-25660
+ e2-25661)
(values
'define-form
- (wrap-6578
- name-23148
- w-22820
- mod-22823)
- (wrap-6578
- e-22818
- w-22820
- mod-22823)
- (let ((e-23159
+ (if (if (null? (car w-25086))
+ (null? (cdr w-25086))
+ #f)
+ name-25658
+ (if (if (vector?
+ name-25658)
+ (if (= (vector-length
+ name-25658)
+ 4)
+ (eq? (vector-ref
+ name-25658
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-25691
+ (vector-ref
+ name-25658
+ 1))
+ (wrap-25692
+ (let ((w2-25702
+ (vector-ref
+ name-25658
+ 2)))
+ (let ((m1-25703
+ (car w-25086))
+ (s1-25704
+ (cdr w-25086)))
+ (if (null? m1-25703)
+ (if (null? s1-25704)
+ w2-25702
+ (cons (car w2-25702)
+ (let ((m2-25721
+ (cdr w2-25702)))
+ (if (null? m2-25721)
+ s1-25704
+ (append
+ s1-25704
+ m2-25721)))))
+ (cons (let ((m2-25729
+ (car w2-25702)))
+ (if (null? m2-25729)
+ m1-25703
+ (append
+ m1-25703
+ m2-25729)))
+ (let ((m2-25737
+ (cdr w2-25702)))
+ (if (null? m2-25737)
+ s1-25704
+ (append
+ s1-25704
+ m2-25737))))))))
+ (module-25693
+ (vector-ref
+ name-25658
+ 3)))
+ (vector
+ 'syntax-object
+ expression-25691
+ wrap-25692
+ module-25693))
+ (if (null? name-25658)
+ name-25658
+ (vector
+ 'syntax-object
+ name-25658
+ w-25086
+ mod-25089))))
+ (if (if (null? (car w-25086))
+ (null? (cdr w-25086))
+ #f)
+ e-25084
+ (if (if (vector? e-25084)
+ (if (= (vector-length
+ e-25084)
+ 4)
+ (eq? (vector-ref
+ e-25084
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-25789
+ (vector-ref
+ e-25084
+ 1))
+ (wrap-25790
+ (let ((w2-25800
+ (vector-ref
+ e-25084
+ 2)))
+ (let ((m1-25801
+ (car w-25086))
+ (s1-25802
+ (cdr w-25086)))
+ (if (null? m1-25801)
+ (if (null? s1-25802)
+ w2-25800
+ (cons (car w2-25800)
+ (let ((m2-25819
+ (cdr w2-25800)))
+ (if (null? m2-25819)
+ s1-25802
+ (append
+ s1-25802
+ m2-25819)))))
+ (cons (let ((m2-25827
+ (car w2-25800)))
+ (if (null? m2-25827)
+ m1-25801
+ (append
+ m1-25801
+ m2-25827)))
+ (let ((m2-25835
+ (cdr w2-25800)))
+ (if (null? m2-25835)
+ s1-25802
+ (append
+ s1-25802
+ m2-25835))))))))
+ (module-25791
+ (vector-ref
+ e-25084
+ 3)))
+ (vector
+ 'syntax-object
+ expression-25789
+ wrap-25790
+ module-25791))
+ (if (null? e-25084)
+ e-25084
+ (vector
+ 'syntax-object
+ e-25084
+ w-25086
+ mod-25089))))
+ (let ((e-25861
(cons '#(syntax-object
lambda
((top)
@@ -1678,10 +2183,10 @@
(top)
(top)
(top))
- #("l-*-4009"
- "l-*-4010"
- "l-*-4011"
- "l-*-4012"))
+ #("l-*-2021"
+ "l-*-2022"
+ "l-*-2023"
+ "l-*-2024"))
#(ribcage
()
()
@@ -1705,13 +2210,13 @@
(top)
(top)
(top))
- #("l-*-3961"
- "l-*-3962"
- "l-*-3963"
- "l-*-3964"
- "l-*-3965"
- "l-*-3966"
- "l-*-3967"))
+ #("l-*-1973"
+ "l-*-1974"
+ "l-*-1975"
+ "l-*-1976"
+ "l-*-1977"
+ "l-*-1978"
+ "l-*-1979"))
#(ribcage
()
()
@@ -1719,7 +2224,7 @@
#(ribcage
#(first)
#((top))
- #("l-*-3952"))
+ #("l-*-1964"))
#(ribcage
()
()
@@ -1747,13 +2252,13 @@
(top)
(top)
(top))
- #("l-*-3924"
- "l-*-3925"
- "l-*-3926"
- "l-*-3927"
- "l-*-3928"
- "l-*-3929"
- "l-*-3930"))
+ #("l-*-1943"
+ "l-*-1944"
+ "l-*-1945"
+ "l-*-1946"
+ "l-*-1947"
+ "l-*-1948"
+ "l-*-1949"))
#(ribcage
(lambda-var-list
gen-var
@@ -1768,7 +2273,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -1824,7 +2329,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -1850,6 +2354,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -1861,7 +2366,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -1882,8 +2387,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -2034,147 +2540,149 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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
@@ -2182,76 +2690,277 @@
((top)
(top)
(top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage
+ ()
+ ()
+ ()))
(hygiene
guile))
- (wrap-6578
- (cons args-23149
- (cons e1-23150
- e2-23151))
- w-22820
- mod-22823))))
+ (let ((x-25865
+ (cons args-25659
+ (cons e1-25660
+ e2-25661))))
+ (if (if (null? (car w-25086))
+ (null? (cdr w-25086))
+ #f)
+ x-25865
+ (if (if (vector?
+ x-25865)
+ (if (= (vector-length
+ x-25865)
+ 4)
+ (eq? (vector-ref
+ x-25865
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-25883
+ (vector-ref
+ x-25865
+ 1))
+ (wrap-25884
+ (let ((w2-25892
+ (vector-ref
+ x-25865
+ 2)))
+ (let ((m1-25893
+ (car w-25086))
+ (s1-25894
+ (cdr w-25086)))
+ (if (null? m1-25893)
+ (if (null? s1-25894)
+ w2-25892
+ (cons (car w2-25892)
+ (let ((m2-25909
+ (cdr w2-25892)))
+ (if (null? m2-25909)
+ s1-25894
+ (append
+ s1-25894
+ m2-25909)))))
+ (cons (let ((m2-25917
+ (car w2-25892)))
+ (if (null? m2-25917)
+ m1-25893
+ (append
+ m1-25893
+ m2-25917)))
+ (let ((m2-25925
+ (cdr w2-25892)))
+ (if (null? m2-25925)
+ s1-25894
+ (append
+ s1-25894
+ m2-25925))))))))
+ (module-25885
+ (vector-ref
+ x-25865
+ 3)))
+ (vector
+ 'syntax-object
+ expression-25883
+ wrap-25884
+ module-25885))
+ (if (null? x-25865)
+ x-25865
+ (vector
+ 'syntax-object
+ x-25865
+ w-25086
+ mod-25089))))))))
(begin
- (if (if (pair? e-23159)
- s-22821
+ (if (if (pair? e-25861)
+ s-25087
#f)
(set-source-properties!
- e-23159
- s-22821))
- e-23159))
+ e-25861
+ s-25087))
+ e-25861))
'(())
- s-22821
- mod-22823))
- tmp-22944)
- (let ((tmp-23166
+ s-25087
+ mod-25089))
+ tmp-25188)
+ (let ((tmp-25944
($sc-dispatch
- e-22818
+ e-25084
'(_ any))))
- (if (if tmp-23166
+ (if (if tmp-25944
(@apply
- (lambda (name-23170)
+ (lambda (name-25948)
(if (symbol?
- name-23170)
+ name-25948)
#t
(if (if (vector?
- name-23170)
+ name-25948)
(if (= (vector-length
- name-23170)
+ name-25948)
4)
(eq? (vector-ref
- name-23170
+ name-25948
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-23170
+ name-25948
1))
#f)))
- tmp-23166)
+ tmp-25944)
#f)
(@apply
- (lambda (name-23197)
+ (lambda (name-25975)
(values
'define-form
- (wrap-6578
- name-23197
- w-22820
- mod-22823)
- (wrap-6578
- e-22818
- w-22820
- mod-22823)
+ (if (if (null? (car w-25086))
+ (null? (cdr w-25086))
+ #f)
+ name-25975
+ (if (if (vector?
+ name-25975)
+ (if (= (vector-length
+ name-25975)
+ 4)
+ (eq? (vector-ref
+ name-25975
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-26005
+ (vector-ref
+ name-25975
+ 1))
+ (wrap-26006
+ (let ((w2-26016
+ (vector-ref
+ name-25975
+ 2)))
+ (let ((m1-26017
+ (car w-25086))
+ (s1-26018
+ (cdr w-25086)))
+ (if (null? m1-26017)
+ (if (null? s1-26018)
+ w2-26016
+ (cons (car w2-26016)
+ (let ((m2-26035
+ (cdr w2-26016)))
+ (if (null? m2-26035)
+ s1-26018
+ (append
+ s1-26018
+ m2-26035)))))
+ (cons (let ((m2-26043
+ (car w2-26016)))
+ (if (null? m2-26043)
+ m1-26017
+ (append
+ m1-26017
+ m2-26043)))
+ (let ((m2-26051
+ (cdr w2-26016)))
+ (if (null? m2-26051)
+ s1-26018
+ (append
+ s1-26018
+ m2-26051))))))))
+ (module-26007
+ (vector-ref
+ name-25975
+ 3)))
+ (vector
+ 'syntax-object
+ expression-26005
+ wrap-26006
+ module-26007))
+ (if (null? name-25975)
+ name-25975
+ (vector
+ 'syntax-object
+ name-25975
+ w-25086
+ mod-25089))))
+ (if (if (null? (car w-25086))
+ (null? (cdr w-25086))
+ #f)
+ e-25084
+ (if (if (vector?
+ e-25084)
+ (if (= (vector-length
+ e-25084)
+ 4)
+ (eq? (vector-ref
+ e-25084
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-26103
+ (vector-ref
+ e-25084
+ 1))
+ (wrap-26104
+ (let ((w2-26114
+ (vector-ref
+ e-25084
+ 2)))
+ (let ((m1-26115
+ (car w-25086))
+ (s1-26116
+ (cdr w-25086)))
+ (if (null? m1-26115)
+ (if (null? s1-26116)
+ w2-26114
+ (cons (car w2-26114)
+ (let ((m2-26133
+ (cdr w2-26114)))
+ (if (null? m2-26133)
+ s1-26116
+ (append
+ s1-26116
+ m2-26133)))))
+ (cons (let ((m2-26141
+ (car w2-26114)))
+ (if (null? m2-26141)
+ m1-26115
+ (append
+ m1-26115
+ m2-26141)))
+ (let ((m2-26149
+ (cdr w2-26114)))
+ (if (null? m2-26149)
+ s1-26116
+ (append
+ s1-26116
+ m2-26149))))))))
+ (module-26105
+ (vector-ref
+ e-25084
+ 3)))
+ (vector
+ 'syntax-object
+ expression-26103
+ wrap-26104
+ module-26105))
+ (if (null? e-25084)
+ e-25084
+ (vector
+ 'syntax-object
+ e-25084
+ w-25086
+ mod-25089))))
'(#(syntax-object
if
((top)
#(ribcage
#(name)
#((top))
- #("l-*-4022"))
+ #("l-*-2034"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2269,18 +2978,18 @@
(top)
(top)
(top))
- #("l-*-3961"
- "l-*-3962"
- "l-*-3963"
- "l-*-3964"
- "l-*-3965"
- "l-*-3966"
- "l-*-3967"))
+ #("l-*-1973"
+ "l-*-1974"
+ "l-*-1975"
+ "l-*-1976"
+ "l-*-1977"
+ "l-*-1978"
+ "l-*-1979"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-3952"))
+ #("l-*-1964"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage () () ())
@@ -2299,13 +3008,13 @@
(top)
(top)
(top))
- #("l-*-3924"
- "l-*-3925"
- "l-*-3926"
- "l-*-3927"
- "l-*-3928"
- "l-*-3929"
- "l-*-3930"))
+ #("l-*-1943"
+ "l-*-1944"
+ "l-*-1945"
+ "l-*-1946"
+ "l-*-1947"
+ "l-*-1948"
+ "l-*-1949"))
#(ribcage
(lambda-var-list
gen-var
@@ -2320,7 +3029,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -2376,7 +3085,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -2402,6 +3110,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -2413,7 +3122,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -2434,8 +3143,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -2586,147 +3296,149 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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
@@ -2734,9 +3446,13 @@
((top)
(top)
(top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage
+ ()
+ ()
+ ()))
(hygiene guile))
#(syntax-object
#f
@@ -2744,7 +3460,7 @@
#(ribcage
#(name)
#((top))
- #("l-*-4022"))
+ #("l-*-2034"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -2762,18 +3478,18 @@
(top)
(top)
(top))
- #("l-*-3961"
- "l-*-3962"
- "l-*-3963"
- "l-*-3964"
- "l-*-3965"
- "l-*-3966"
- "l-*-3967"))
+ #("l-*-1973"
+ "l-*-1974"
+ "l-*-1975"
+ "l-*-1976"
+ "l-*-1977"
+ "l-*-1978"
+ "l-*-1979"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-3952"))
+ #("l-*-1964"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage () () ())
@@ -2792,13 +3508,13 @@
(top)
(top)
(top))
- #("l-*-3924"
- "l-*-3925"
- "l-*-3926"
- "l-*-3927"
- "l-*-3928"
- "l-*-3929"
- "l-*-3930"))
+ #("l-*-1943"
+ "l-*-1944"
+ "l-*-1945"
+ "l-*-1946"
+ "l-*-1947"
+ "l-*-1948"
+ "l-*-1949"))
#(ribcage
(lambda-var-list
gen-var
@@ -2813,7 +3529,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -2869,7 +3585,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -2895,6 +3610,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -2906,7 +3622,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -2927,8 +3643,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -3079,147 +3796,149 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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
@@ -3227,9 +3946,13 @@
((top)
(top)
(top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage
+ ()
+ ()
+ ()))
(hygiene guile))
#(syntax-object
#f
@@ -3237,7 +3960,7 @@
#(ribcage
#(name)
#((top))
- #("l-*-4022"))
+ #("l-*-2034"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
@@ -3255,18 +3978,18 @@
(top)
(top)
(top))
- #("l-*-3961"
- "l-*-3962"
- "l-*-3963"
- "l-*-3964"
- "l-*-3965"
- "l-*-3966"
- "l-*-3967"))
+ #("l-*-1973"
+ "l-*-1974"
+ "l-*-1975"
+ "l-*-1976"
+ "l-*-1977"
+ "l-*-1978"
+ "l-*-1979"))
#(ribcage () () ())
#(ribcage
#(first)
#((top))
- #("l-*-3952"))
+ #("l-*-1964"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage () () ())
@@ -3285,13 +4008,13 @@
(top)
(top)
(top))
- #("l-*-3924"
- "l-*-3925"
- "l-*-3926"
- "l-*-3927"
- "l-*-3928"
- "l-*-3929"
- "l-*-3930"))
+ #("l-*-1943"
+ "l-*-1944"
+ "l-*-1945"
+ "l-*-1946"
+ "l-*-1947"
+ "l-*-1948"
+ "l-*-1949"))
#(ribcage
(lambda-var-list
gen-var
@@ -3306,7 +4029,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -3362,7 +4085,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -3388,6 +4110,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -3399,7 +4122,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -3420,8 +4143,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -3572,147 +4296,149 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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
@@ -3720,2679 +4446,2873 @@
((top)
(top)
(top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage
+ ()
+ ()
+ ()))
(hygiene guile)))
'(())
- s-22821
- mod-22823))
- tmp-23166)
+ s-25087
+ mod-25089))
+ tmp-25944)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-22818)))))))
- (if (eqv? ftype-22862 'define-syntax)
- (let ((tmp-23218
+ e-25084)))))))
+ (if (eqv? ftype-25106 'define-syntax)
+ (let ((tmp-26188
($sc-dispatch
- e-22818
+ e-25084
'(_ any any))))
- (if (if tmp-23218
+ (if (if tmp-26188
(@apply
- (lambda (name-23222 val-23223)
- (if (symbol? name-23222)
+ (lambda (name-26192 val-26193)
+ (if (symbol? name-26192)
#t
(if (if (vector?
- name-23222)
+ name-26192)
(if (= (vector-length
- name-23222)
+ name-26192)
4)
(eq? (vector-ref
- name-23222
+ name-26192
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-23222
+ name-26192
1))
#f)))
- tmp-23218)
+ tmp-26188)
#f)
(@apply
- (lambda (name-23250 val-23251)
+ (lambda (name-26220 val-26221)
(values
'define-syntax-form
- name-23250
- e-22818
- val-23251
- w-22820
- s-22821
- mod-22823))
- tmp-23218)
+ name-26220
+ e-25084
+ val-26221
+ w-25086
+ s-25087
+ mod-25089))
+ tmp-26188)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-22818)))
- (if (eqv? ftype-22862
+ e-25084)))
+ (if (eqv? ftype-25106
'define-syntax-parameter)
- (let ((tmp-23262
+ (let ((tmp-26232
($sc-dispatch
- e-22818
+ e-25084
'(_ any any))))
- (if (if tmp-23262
+ (if (if tmp-26232
(@apply
- (lambda (name-23266
- val-23267)
- (if (symbol? name-23266)
+ (lambda (name-26236
+ val-26237)
+ (if (symbol? name-26236)
#t
(if (if (vector?
- name-23266)
+ name-26236)
(if (= (vector-length
- name-23266)
+ name-26236)
4)
(eq? (vector-ref
- name-23266
+ name-26236
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- name-23266
+ name-26236
1))
#f)))
- tmp-23262)
+ tmp-26232)
#f)
(@apply
- (lambda (name-23294 val-23295)
+ (lambda (name-26264 val-26265)
(values
'define-syntax-parameter-form
- name-23294
- e-22818
- val-23295
- w-22820
- s-22821
- mod-22823))
- tmp-23262)
+ name-26264
+ e-25084
+ val-26265
+ w-25086
+ s-25087
+ mod-25089))
+ tmp-26232)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-22818)))
+ e-25084)))
(values
'call
#f
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)))))))))))))))
- (if (if (vector? e-22818)
- (if (= (vector-length e-22818) 4)
- (eq? (vector-ref e-22818 0) 'syntax-object)
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)))))))))))))))
+ (if (if (vector? e-25084)
+ (if (= (vector-length e-25084) 4)
+ (eq? (vector-ref e-25084 0) 'syntax-object)
#f)
#f)
- (syntax-type-6584
- (vector-ref e-22818 1)
- r-22819
- (join-wraps-6565 w-22820 (vector-ref e-22818 2))
- (let ((t-23322 (source-annotation-6542 e-22818)))
- (if t-23322 t-23322 s-22821))
- rib-22822
- (let ((t-23557 (vector-ref e-22818 3)))
- (if t-23557 t-23557 mod-22823))
- for-car?-22824)
- (if (self-evaluating? e-22818)
+ (syntax-type-4585
+ (vector-ref e-25084 1)
+ r-25085
+ (let ((w2-26290 (vector-ref e-25084 2)))
+ (let ((m1-26291 (car w-25086))
+ (s1-26292 (cdr w-25086)))
+ (if (null? m1-26291)
+ (if (null? s1-26292)
+ w2-26290
+ (cons (car w2-26290)
+ (let ((m2-26303 (cdr w2-26290)))
+ (if (null? m2-26303)
+ s1-26292
+ (append s1-26292 m2-26303)))))
+ (cons (let ((m2-26311 (car w2-26290)))
+ (if (null? m2-26311)
+ m1-26291
+ (append m1-26291 m2-26311)))
+ (let ((m2-26319 (cdr w2-26290)))
+ (if (null? m2-26319)
+ s1-26292
+ (append s1-26292 m2-26319)))))))
+ (let ((t-26324 (source-annotation-4544 e-25084)))
+ (if t-26324 t-26324 s-25087))
+ rib-25088
+ (let ((t-26600 (vector-ref e-25084 3)))
+ (if t-26600 t-26600 mod-25089))
+ for-car?-25090)
+ (if (self-evaluating? e-25084)
(values
'constant
#f
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)
(values
'other
#f
- e-22818
- e-22818
- w-22820
- s-22821
- mod-22823)))))))
- (expand-6585
- (lambda (e-23566 r-23567 w-23568 mod-23569)
+ e-25084
+ e-25084
+ w-25086
+ s-25087
+ mod-25089)))))))
+ (expand-4586
+ (lambda (e-26609 r-26610 w-26611 mod-26612)
(call-with-values
(lambda ()
- (syntax-type-6584
- e-23566
- r-23567
- w-23568
- (source-annotation-6542 e-23566)
+ (syntax-type-4585
+ e-26609
+ r-26610
+ w-26611
+ (source-annotation-4544 e-26609)
#f
- mod-23569
+ mod-26612
#f))
- (lambda (type-23724
- value-23725
- form-23726
- e-23727
- w-23728
- s-23729
- mod-23730)
- (expand-expr-6586
- type-23724
- value-23725
- form-23726
- e-23727
- r-23567
- w-23728
- s-23729
- mod-23730)))))
- (expand-expr-6586
- (lambda (type-23733
- value-23734
- form-23735
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740)
- (if (eqv? type-23733 'lexical)
+ (lambda (type-26798
+ value-26799
+ form-26800
+ e-26801
+ w-26802
+ s-26803
+ mod-26804)
+ (expand-expr-4587
+ type-26798
+ value-26799
+ form-26800
+ e-26801
+ r-26610
+ w-26802
+ s-26803
+ mod-26804)))))
+ (expand-expr-4587
+ (lambda (type-26807
+ value-26808
+ form-26809
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
+ (if (eqv? type-26807 'lexical)
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
- s-23739
- e-23736
- value-23734)
- (if (if (eqv? type-23733 'core)
+ s-26813
+ e-26810
+ value-26808)
+ (if (if (eqv? type-26807 'core)
#t
- (eqv? type-23733 'core-form))
- (value-23734
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740)
- (if (eqv? type-23733 'module-ref)
+ (eqv? type-26807 'core-form))
+ (value-26808
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
+ (if (eqv? type-26807 'module-ref)
(call-with-values
- (lambda () (value-23734 e-23736 r-23737 w-23738))
- (lambda (e-23766 r-23767 w-23768 s-23769 mod-23770)
- (expand-6585 e-23766 r-23767 w-23768 mod-23770)))
- (if (eqv? type-23733 'lexical-call)
- (expand-application-6587
- (let ((id-23845 (car e-23736)))
- (build-lexical-reference-6519
+ (lambda () (value-26808 e-26810 r-26811 w-26812))
+ (lambda (e-26840 r-26841 w-26842 s-26843 mod-26844)
+ (expand-4586 e-26840 r-26841 w-26842 mod-26844)))
+ (if (eqv? type-26807 'lexical-call)
+ (expand-call-4588
+ (let ((id-27017 (car e-26810)))
+ (build-lexical-reference-4520
'fun
- (source-annotation-6542 id-23845)
- (if (if (vector? id-23845)
- (if (= (vector-length id-23845) 4)
- (eq? (vector-ref id-23845 0) 'syntax-object)
+ (source-annotation-4544 id-27017)
+ (if (if (vector? id-27017)
+ (if (= (vector-length id-27017) 4)
+ (eq? (vector-ref id-27017 0) 'syntax-object)
#f)
#f)
- (syntax->datum id-23845)
- id-23845)
- value-23734))
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740)
- (if (eqv? type-23733 'global-call)
- (expand-application-6587
- (build-global-reference-6522
- (source-annotation-6542 (car e-23736))
- (if (if (vector? value-23734)
- (if (= (vector-length value-23734) 4)
- (eq? (vector-ref value-23734 0) 'syntax-object)
+ (syntax->datum id-27017)
+ id-27017)
+ value-26808))
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
+ (if (eqv? type-26807 'global-call)
+ (expand-call-4588
+ (build-global-reference-4523
+ (source-annotation-4544 (car e-26810))
+ (if (if (vector? value-26808)
+ (if (= (vector-length value-26808) 4)
+ (eq? (vector-ref value-26808 0) 'syntax-object)
#f)
#f)
- (vector-ref value-23734 1)
- value-23734)
- (if (if (vector? value-23734)
- (if (= (vector-length value-23734) 4)
- (eq? (vector-ref value-23734 0) 'syntax-object)
+ (vector-ref value-26808 1)
+ value-26808)
+ (if (if (vector? value-26808)
+ (if (= (vector-length value-26808) 4)
+ (eq? (vector-ref value-26808 0) 'syntax-object)
#f)
#f)
- (vector-ref value-23734 3)
- mod-23740))
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740)
- (if (eqv? type-23733 'constant)
- (let ((exp-24182
- (strip-6598
- (wrap-6578
- (begin
- (if (if (pair? e-23736) s-23739 #f)
- (set-source-properties! e-23736 s-23739))
- e-23736)
- w-23738
- mod-23740)
+ (vector-ref value-26808 3)
+ mod-26814))
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
+ (if (eqv? type-26807 'constant)
+ (let ((exp-27691
+ (strip-4599
+ (let ((x-27704
+ (begin
+ (if (if (pair? e-26810) s-26813 #f)
+ (set-source-properties!
+ e-26810
+ s-26813))
+ e-26810)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-27704
+ (if (if (vector? x-27704)
+ (if (= (vector-length x-27704) 4)
+ (eq? (vector-ref x-27704 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-27736
+ (vector-ref x-27704 1))
+ (wrap-27737
+ (let ((w2-27745
+ (vector-ref x-27704 2)))
+ (let ((m1-27746 (car w-26812))
+ (s1-27747 (cdr w-26812)))
+ (if (null? m1-27746)
+ (if (null? s1-27747)
+ w2-27745
+ (cons (car w2-27745)
+ (let ((m2-27762
+ (cdr w2-27745)))
+ (if (null? m2-27762)
+ s1-27747
+ (append
+ s1-27747
+ m2-27762)))))
+ (cons (let ((m2-27770
+ (car w2-27745)))
+ (if (null? m2-27770)
+ m1-27746
+ (append
+ m1-27746
+ m2-27770)))
+ (let ((m2-27778
+ (cdr w2-27745)))
+ (if (null? m2-27778)
+ s1-27747
+ (append
+ s1-27747
+ m2-27778))))))))
+ (module-27738
+ (vector-ref x-27704 3)))
+ (vector
+ 'syntax-object
+ expression-27736
+ wrap-27737
+ module-27738))
+ (if (null? x-27704)
+ x-27704
+ (vector
+ 'syntax-object
+ x-27704
+ w-26812
+ mod-26814)))))
'(()))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-23739
- exp-24182))
- (if (eqv? type-23733 'global)
- (analyze-variable-6521
- mod-23740
- value-23734
- (lambda (mod-24218 var-24219 public?-24220)
+ s-26813
+ exp-27691))
+ (if (eqv? type-26807 'global)
+ (analyze-variable-4522
+ mod-26814
+ value-26808
+ (lambda (mod-27803 var-27804 public?-27805)
(make-struct/no-tail
(vector-ref %expanded-vtables 5)
- s-23739
- mod-24218
- var-24219
- public?-24220))
- (lambda (var-24229)
+ s-26813
+ mod-27803
+ var-27804
+ public?-27805))
+ (lambda (var-27813)
(make-struct/no-tail
(vector-ref %expanded-vtables 7)
- s-23739
- var-24229)))
- (if (eqv? type-23733 'call)
- (expand-application-6587
- (expand-6585
- (car e-23736)
- r-23737
- w-23738
- mod-23740)
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740)
- (if (eqv? type-23733 'begin-form)
- (let ((tmp-24304
- ($sc-dispatch e-23736 '(_ any . each-any))))
- (if tmp-24304
+ s-26813
+ var-27813)))
+ (if (eqv? type-26807 'call)
+ (expand-call-4588
+ (expand-4586
+ (car e-26810)
+ r-26811
+ w-26812
+ mod-26814)
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
+ (if (eqv? type-26807 'begin-form)
+ (let ((tmp-27983
+ ($sc-dispatch e-26810 '(_ any . each-any))))
+ (if tmp-27983
(@apply
- (lambda (e1-24308 e2-24309)
- (expand-sequence-6580
- (cons e1-24308 e2-24309)
- r-23737
- w-23738
- s-23739
- mod-23740))
- tmp-24304)
- (let ((tmp-24396 ($sc-dispatch e-23736 '(_))))
- (if tmp-24396
+ (lambda (e1-27987 e2-27988)
+ (expand-sequence-4581
+ (cons e1-27987 e2-27988)
+ r-26811
+ w-26812
+ s-26813
+ mod-26814))
+ tmp-27983)
+ (let ((tmp-28083 ($sc-dispatch e-26810 '(_))))
+ (if tmp-28083
(@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))
- (syntax-violation
- #f
- "sequence of zero expressions"
- (wrap-6578
- (begin
- (if (if (pair? e-23736)
- s-23739
+ (syntax-violation
+ #f
+ "sequence of zero expressions"
+ (let ((x-28096
+ (begin
+ (if (if (pair? e-26810)
+ s-26813
+ #f)
+ (set-source-properties!
+ e-26810
+ s-26813))
+ e-26810)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-28096
+ (if (if (vector? x-28096)
+ (if (= (vector-length
+ x-28096)
+ 4)
+ (eq? (vector-ref
+ x-28096
+ 0)
+ 'syntax-object)
#f)
- (set-source-properties!
- e-23736
- s-23739))
- e-23736)
- w-23738
- mod-23740))))
- tmp-24396)
+ #f)
+ (let ((expression-28128
+ (vector-ref x-28096 1))
+ (wrap-28129
+ (let ((w2-28137
+ (vector-ref
+ x-28096
+ 2)))
+ (let ((m1-28138
+ (car w-26812))
+ (s1-28139
+ (cdr w-26812)))
+ (if (null? m1-28138)
+ (if (null? s1-28139)
+ w2-28137
+ (cons (car w2-28137)
+ (let ((m2-28154
+ (cdr w2-28137)))
+ (if (null? m2-28154)
+ s1-28139
+ (append
+ s1-28139
+ m2-28154)))))
+ (cons (let ((m2-28162
+ (car w2-28137)))
+ (if (null? m2-28162)
+ m1-28138
+ (append
+ m1-28138
+ m2-28162)))
+ (let ((m2-28170
+ (cdr w2-28137)))
+ (if (null? m2-28170)
+ s1-28139
+ (append
+ s1-28139
+ m2-28170))))))))
+ (module-28130
+ (vector-ref x-28096 3)))
+ (vector
+ 'syntax-object
+ expression-28128
+ wrap-28129
+ module-28130))
+ (if (null? x-28096)
+ x-28096
+ (vector
+ 'syntax-object
+ x-28096
+ w-26812
+ mod-26814)))))))
+ tmp-28083)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-23736)))))
- (if (eqv? type-23733 'local-syntax-form)
- (expand-local-syntax-6590
- value-23734
- e-23736
- r-23737
- w-23738
- s-23739
- mod-23740
- expand-sequence-6580)
- (if (eqv? type-23733 'eval-when-form)
- (let ((tmp-24507
+ e-26810)))))
+ (if (eqv? type-26807 'local-syntax-form)
+ (expand-local-syntax-4591
+ value-26808
+ e-26810
+ r-26811
+ w-26812
+ s-26813
+ mod-26814
+ expand-sequence-4581)
+ (if (eqv? type-26807 'eval-when-form)
+ (let ((tmp-28265
($sc-dispatch
- e-23736
+ e-26810
'(_ each-any any . each-any))))
- (if tmp-24507
+ (if tmp-28265
(@apply
- (lambda (x-24511 e1-24512 e2-24513)
- (let ((when-list-24514
- (parse-when-list-6583
- e-23736
- x-24511)))
- (if (memq 'eval when-list-24514)
- (expand-sequence-6580
- (cons e1-24512 e2-24513)
- r-23737
- w-23738
- s-23739
- mod-23740)
+ (lambda (x-28269 e1-28270 e2-28271)
+ (let ((when-list-28272
+ (parse-when-list-4584
+ e-26810
+ x-28269)))
+ (if (memq 'eval when-list-28272)
+ (expand-sequence-4581
+ (cons e1-28270 e2-28271)
+ r-26811
+ w-26812
+ s-26813
+ mod-26814)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
#f))))
- tmp-24507)
+ tmp-28265)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-23736)))
- (if (if (eqv? type-23733 'define-form)
+ e-26810)))
+ (if (if (eqv? type-26807 'define-form)
#t
- (if (eqv? type-23733 'define-syntax-form)
+ (if (eqv? type-26807 'define-syntax-form)
#t
- (eqv? type-23733
+ (eqv? type-26807
'define-syntax-parameter-form)))
(syntax-violation
#f
"definition in expression context, where definitions are not allowed,"
- (wrap-6578
- (begin
- (if (if (pair? form-23735) s-23739 #f)
- (set-source-properties!
- form-23735
- s-23739))
- form-23735)
- w-23738
- mod-23740))
- (if (eqv? type-23733 'syntax)
+ (let ((x-28458
+ (begin
+ (if (if (pair? form-26809)
+ s-26813
+ #f)
+ (set-source-properties!
+ form-26809
+ s-26813))
+ form-26809)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-28458
+ (if (if (vector? x-28458)
+ (if (= (vector-length x-28458) 4)
+ (eq? (vector-ref x-28458 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-28490
+ (vector-ref x-28458 1))
+ (wrap-28491
+ (let ((w2-28499
+ (vector-ref
+ x-28458
+ 2)))
+ (let ((m1-28500
+ (car w-26812))
+ (s1-28501
+ (cdr w-26812)))
+ (if (null? m1-28500)
+ (if (null? s1-28501)
+ w2-28499
+ (cons (car w2-28499)
+ (let ((m2-28516
+ (cdr w2-28499)))
+ (if (null? m2-28516)
+ s1-28501
+ (append
+ s1-28501
+ m2-28516)))))
+ (cons (let ((m2-28524
+ (car w2-28499)))
+ (if (null? m2-28524)
+ m1-28500
+ (append
+ m1-28500
+ m2-28524)))
+ (let ((m2-28532
+ (cdr w2-28499)))
+ (if (null? m2-28532)
+ s1-28501
+ (append
+ s1-28501
+ m2-28532))))))))
+ (module-28492
+ (vector-ref x-28458 3)))
+ (vector
+ 'syntax-object
+ expression-28490
+ wrap-28491
+ module-28492))
+ (if (null? x-28458)
+ x-28458
+ (vector
+ 'syntax-object
+ x-28458
+ w-26812
+ mod-26814))))))
+ (if (eqv? type-26807 'syntax)
(syntax-violation
#f
"reference to pattern variable outside syntax form"
- (wrap-6578
- (begin
- (if (if (pair? e-23736) s-23739 #f)
- (set-source-properties!
- e-23736
- s-23739))
- e-23736)
- w-23738
- mod-23740))
- (if (eqv? type-23733 'displaced-lexical)
+ (let ((x-28559
+ (begin
+ (if (if (pair? e-26810)
+ s-26813
+ #f)
+ (set-source-properties!
+ e-26810
+ s-26813))
+ e-26810)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-28559
+ (if (if (vector? x-28559)
+ (if (= (vector-length x-28559)
+ 4)
+ (eq? (vector-ref x-28559 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-28591
+ (vector-ref x-28559 1))
+ (wrap-28592
+ (let ((w2-28600
+ (vector-ref
+ x-28559
+ 2)))
+ (let ((m1-28601
+ (car w-26812))
+ (s1-28602
+ (cdr w-26812)))
+ (if (null? m1-28601)
+ (if (null? s1-28602)
+ w2-28600
+ (cons (car w2-28600)
+ (let ((m2-28617
+ (cdr w2-28600)))
+ (if (null? m2-28617)
+ s1-28602
+ (append
+ s1-28602
+ m2-28617)))))
+ (cons (let ((m2-28625
+ (car w2-28600)))
+ (if (null? m2-28625)
+ m1-28601
+ (append
+ m1-28601
+ m2-28625)))
+ (let ((m2-28633
+ (cdr w2-28600)))
+ (if (null? m2-28633)
+ s1-28602
+ (append
+ s1-28602
+ m2-28633))))))))
+ (module-28593
+ (vector-ref x-28559 3)))
+ (vector
+ 'syntax-object
+ expression-28591
+ wrap-28592
+ module-28593))
+ (if (null? x-28559)
+ x-28559
+ (vector
+ 'syntax-object
+ x-28559
+ w-26812
+ mod-26814))))))
+ (if (eqv? type-26807 'displaced-lexical)
(syntax-violation
#f
"reference to identifier outside its scope"
- (wrap-6578
- (begin
- (if (if (pair? e-23736) s-23739 #f)
- (set-source-properties!
- e-23736
- s-23739))
- e-23736)
- w-23738
- mod-23740))
+ (let ((x-28660
+ (begin
+ (if (if (pair? e-26810)
+ s-26813
+ #f)
+ (set-source-properties!
+ e-26810
+ s-26813))
+ e-26810)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-28660
+ (if (if (vector? x-28660)
+ (if (= (vector-length x-28660)
+ 4)
+ (eq? (vector-ref x-28660 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-28692
+ (vector-ref x-28660 1))
+ (wrap-28693
+ (let ((w2-28701
+ (vector-ref
+ x-28660
+ 2)))
+ (let ((m1-28702
+ (car w-26812))
+ (s1-28703
+ (cdr w-26812)))
+ (if (null? m1-28702)
+ (if (null? s1-28703)
+ w2-28701
+ (cons (car w2-28701)
+ (let ((m2-28718
+ (cdr w2-28701)))
+ (if (null? m2-28718)
+ s1-28703
+ (append
+ s1-28703
+ m2-28718)))))
+ (cons (let ((m2-28726
+ (car w2-28701)))
+ (if (null? m2-28726)
+ m1-28702
+ (append
+ m1-28702
+ m2-28726)))
+ (let ((m2-28734
+ (cdr w2-28701)))
+ (if (null? m2-28734)
+ s1-28703
+ (append
+ s1-28703
+ m2-28734))))))))
+ (module-28694
+ (vector-ref x-28660 3)))
+ (vector
+ 'syntax-object
+ expression-28692
+ wrap-28693
+ module-28694))
+ (if (null? x-28660)
+ x-28660
+ (vector
+ 'syntax-object
+ x-28660
+ w-26812
+ mod-26814))))))
(syntax-violation
#f
"unexpected syntax"
- (wrap-6578
- (begin
- (if (if (pair? e-23736) s-23739 #f)
- (set-source-properties!
- e-23736
- s-23739))
- e-23736)
- w-23738
- mod-23740))))))))))))))))))
- (expand-application-6587
- (lambda (x-24774
- e-24775
- r-24776
- w-24777
- s-24778
- mod-24779)
- (let ((tmp-24781
- ($sc-dispatch e-24775 '(any . each-any))))
- (if tmp-24781
+ (let ((x-28758
+ (begin
+ (if (if (pair? e-26810)
+ s-26813
+ #f)
+ (set-source-properties!
+ e-26810
+ s-26813))
+ e-26810)))
+ (if (if (null? (car w-26812))
+ (null? (cdr w-26812))
+ #f)
+ x-28758
+ (if (if (vector? x-28758)
+ (if (= (vector-length x-28758)
+ 4)
+ (eq? (vector-ref x-28758 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-28790
+ (vector-ref x-28758 1))
+ (wrap-28791
+ (let ((w2-28799
+ (vector-ref
+ x-28758
+ 2)))
+ (let ((m1-28800
+ (car w-26812))
+ (s1-28801
+ (cdr w-26812)))
+ (if (null? m1-28800)
+ (if (null? s1-28801)
+ w2-28799
+ (cons (car w2-28799)
+ (let ((m2-28816
+ (cdr w2-28799)))
+ (if (null? m2-28816)
+ s1-28801
+ (append
+ s1-28801
+ m2-28816)))))
+ (cons (let ((m2-28824
+ (car w2-28799)))
+ (if (null? m2-28824)
+ m1-28800
+ (append
+ m1-28800
+ m2-28824)))
+ (let ((m2-28832
+ (cdr w2-28799)))
+ (if (null? m2-28832)
+ s1-28801
+ (append
+ s1-28801
+ m2-28832))))))))
+ (module-28792
+ (vector-ref x-28758 3)))
+ (vector
+ 'syntax-object
+ expression-28790
+ wrap-28791
+ module-28792))
+ (if (null? x-28758)
+ x-28758
+ (vector
+ 'syntax-object
+ x-28758
+ w-26812
+ mod-26814))))))))))))))))))))))
+ (expand-call-4588
+ (lambda (x-28847
+ e-28848
+ r-28849
+ w-28850
+ s-28851
+ mod-28852)
+ (let ((tmp-28854
+ ($sc-dispatch e-28848 '(any . each-any))))
+ (if tmp-28854
(@apply
- (lambda (e0-24785 e1-24786)
- (build-application-6516
- s-24778
- x-24774
- (map (lambda (e-24866)
- (expand-6585 e-24866 r-24776 w-24777 mod-24779))
- e1-24786)))
- tmp-24781)
+ (lambda (e0-28858 e1-28859)
+ (build-call-4517
+ s-28851
+ x-28847
+ (map (lambda (e-28947)
+ (expand-4586 e-28947 r-28849 w-28850 mod-28852))
+ e1-28859)))
+ tmp-28854)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-24775)))))
- (expand-macro-6588
- (lambda (p-24942
- e-24943
- r-24944
- w-24945
- s-24946
- rib-24947
- mod-24948)
+ e-28848)))))
+ (expand-macro-4589
+ (lambda (p-29031
+ e-29032
+ r-29033
+ w-29034
+ s-29035
+ rib-29036
+ mod-29037)
(letrec*
- ((rebuild-macro-output-24949
- (lambda (x-24982 m-24983)
- (if (pair? x-24982)
- (let ((e-24987
- (cons (rebuild-macro-output-24949
- (car x-24982)
- m-24983)
- (rebuild-macro-output-24949
- (cdr x-24982)
- m-24983))))
+ ((rebuild-macro-output-29038
+ (lambda (x-29147 m-29148)
+ (if (pair? x-29147)
+ (let ((e-29152
+ (cons (rebuild-macro-output-29038
+ (car x-29147)
+ m-29148)
+ (rebuild-macro-output-29038
+ (cdr x-29147)
+ m-29148))))
(begin
- (if (if (pair? e-24987) s-24946 #f)
- (set-source-properties! e-24987 s-24946))
- e-24987))
- (if (if (vector? x-24982)
- (if (= (vector-length x-24982) 4)
- (eq? (vector-ref x-24982 0) 'syntax-object)
+ (if (if (pair? e-29152) s-29035 #f)
+ (set-source-properties! e-29152 s-29035))
+ e-29152))
+ (if (if (vector? x-29147)
+ (if (= (vector-length x-29147) 4)
+ (eq? (vector-ref x-29147 0) 'syntax-object)
#f)
#f)
- (let ((w-25003 (vector-ref x-24982 2)))
- (let ((ms-25004 (car w-25003))
- (s-25005 (cdr w-25003)))
- (if (if (pair? ms-25004) (eq? (car ms-25004) #f) #f)
- (let ((expression-25013 (vector-ref x-24982 1))
- (wrap-25014
- (cons (cdr ms-25004)
- (if rib-24947
- (cons rib-24947 (cdr s-25005))
- (cdr s-25005))))
- (module-25015 (vector-ref x-24982 3)))
+ (let ((w-29168 (vector-ref x-29147 2)))
+ (let ((ms-29169 (car w-29168))
+ (s-29170 (cdr w-29168)))
+ (if (if (pair? ms-29169) (eq? (car ms-29169) #f) #f)
+ (let ((expression-29178 (vector-ref x-29147 1))
+ (wrap-29179
+ (cons (cdr ms-29169)
+ (if rib-29036
+ (cons rib-29036 (cdr s-29170))
+ (cdr s-29170))))
+ (module-29180 (vector-ref x-29147 3)))
(vector
'syntax-object
- expression-25013
- wrap-25014
- module-25015))
- (let ((expression-25025
- (let ((e-25030 (vector-ref x-24982 1)))
+ expression-29178
+ wrap-29179
+ module-29180))
+ (let ((expression-29190
+ (let ((e-29195 (vector-ref x-29147 1)))
(begin
- (if (if (pair? e-25030) s-25005 #f)
+ (if (if (pair? e-29195) s-29170 #f)
(set-source-properties!
- e-25030
- s-25005))
- e-25030)))
- (wrap-25026
- (cons (cons m-24983 ms-25004)
- (if rib-24947
- (cons rib-24947
- (cons 'shift s-25005))
- (cons 'shift s-25005))))
- (module-25027 (vector-ref x-24982 3)))
+ e-29195
+ s-29170))
+ e-29195)))
+ (wrap-29191
+ (cons (cons m-29148 ms-29169)
+ (if rib-29036
+ (cons rib-29036
+ (cons 'shift s-29170))
+ (cons 'shift s-29170))))
+ (module-29192 (vector-ref x-29147 3)))
(vector
'syntax-object
- expression-25025
- wrap-25026
- module-25027)))))
- (if (vector? x-24982)
- (let ((n-25042 (vector-length x-24982)))
- (let ((v-25043
- (let ((e-25051 (make-vector n-25042)))
+ expression-29190
+ wrap-29191
+ module-29192)))))
+ (if (vector? x-29147)
+ (let ((n-29207 (vector-length x-29147)))
+ (let ((v-29208
+ (let ((e-29274 (make-vector n-29207)))
(begin
- (if (if (pair? e-25051) x-24982 #f)
- (set-source-properties! e-25051 x-24982))
- e-25051))))
+ (if (if (pair? e-29274) x-29147 #f)
+ (set-source-properties! e-29274 x-29147))
+ e-29274))))
(letrec*
- ((loop-25044
- (lambda (i-25096)
- (if (= i-25096 n-25042)
- v-25043
+ ((loop-29209
+ (lambda (i-29270)
+ (if (= i-29270 n-29207)
+ v-29208
(begin
(vector-set!
- v-25043
- i-25096
- (rebuild-macro-output-24949
- (vector-ref x-24982 i-25096)
- m-24983))
- (loop-25044 (#{1+}# i-25096)))))))
- (loop-25044 0))))
- (if (symbol? x-24982)
+ v-29208
+ i-29270
+ (rebuild-macro-output-29038
+ (vector-ref x-29147 i-29270)
+ m-29148))
+ (loop-29209 (#{1+}# i-29270)))))))
+ (loop-29209 0))))
+ (if (symbol? x-29147)
(syntax-violation
#f
"encountered raw symbol in macro output"
- (let ((s-25102 (cdr w-24945)))
- (wrap-6578
- (begin
- (if (if (pair? e-24943) s-25102 #f)
- (set-source-properties! e-24943 s-25102))
- e-24943)
- w-24945
- mod-24948))
- x-24982)
+ (let ((s-29285 (cdr w-29034)))
+ (let ((x-29289
+ (begin
+ (if (if (pair? e-29032) s-29285 #f)
+ (set-source-properties!
+ e-29032
+ s-29285))
+ e-29032)))
+ (if (if (null? (car w-29034))
+ (null? (cdr w-29034))
+ #f)
+ x-29289
+ (if (if (vector? x-29289)
+ (if (= (vector-length x-29289) 4)
+ (eq? (vector-ref x-29289 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-29321
+ (vector-ref x-29289 1))
+ (wrap-29322
+ (let ((w2-29330
+ (vector-ref x-29289 2)))
+ (let ((m1-29331 (car w-29034))
+ (s1-29332 (cdr w-29034)))
+ (if (null? m1-29331)
+ (if (null? s1-29332)
+ w2-29330
+ (cons (car w2-29330)
+ (let ((m2-29347
+ (cdr w2-29330)))
+ (if (null? m2-29347)
+ s1-29332
+ (append
+ s1-29332
+ m2-29347)))))
+ (cons (let ((m2-29355
+ (car w2-29330)))
+ (if (null? m2-29355)
+ m1-29331
+ (append
+ m1-29331
+ m2-29355)))
+ (let ((m2-29363
+ (cdr w2-29330)))
+ (if (null? m2-29363)
+ s1-29332
+ (append
+ s1-29332
+ m2-29363))))))))
+ (module-29323 (vector-ref x-29289 3)))
+ (vector
+ 'syntax-object
+ expression-29321
+ wrap-29322
+ module-29323))
+ (if (null? x-29289)
+ x-29289
+ (vector
+ 'syntax-object
+ x-29289
+ w-29034
+ mod-29037))))))
+ x-29147)
(begin
- (if (if (pair? x-24982) s-24946 #f)
- (set-source-properties! x-24982 s-24946))
- x-24982))))))))
+ (if (if (pair? x-29147) s-29035 #f)
+ (set-source-properties! x-29147 s-29035))
+ x-29147))))))))
(with-fluids
- ((transformer-environment-6571
- (lambda (k-24950)
- (k-24950
- e-24943
- r-24944
- w-24945
- s-24946
- rib-24947
- mod-24948))))
- (rebuild-macro-output-24949
- (p-24942
- (let ((w-24957
- (cons (cons #f (car w-24945))
- (cons 'shift (cdr w-24945)))))
- (wrap-6578
- (begin
- (if (if (pair? e-24943) s-24946 #f)
- (set-source-properties! e-24943 s-24946))
- e-24943)
- w-24957
- mod-24948)))
+ ((transformer-environment-4572
+ (lambda (k-29039)
+ (k-29039
+ e-29032
+ r-29033
+ w-29034
+ s-29035
+ rib-29036
+ mod-29037))))
+ (rebuild-macro-output-29038
+ (p-29031
+ (let ((w-29046
+ (cons (cons #f (car w-29034))
+ (cons 'shift (cdr w-29034)))))
+ (let ((x-29051
+ (begin
+ (if (if (pair? e-29032) s-29035 #f)
+ (set-source-properties! e-29032 s-29035))
+ e-29032)))
+ (if (if (null? (car w-29046))
+ (null? (cdr w-29046))
+ #f)
+ x-29051
+ (if (if (vector? x-29051)
+ (if (= (vector-length x-29051) 4)
+ (eq? (vector-ref x-29051 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-29090 (vector-ref x-29051 1))
+ (wrap-29091
+ (let ((w2-29099 (vector-ref x-29051 2)))
+ (let ((m1-29100 (car w-29046))
+ (s1-29101 (cdr w-29046)))
+ (if (null? m1-29100)
+ (if (null? s1-29101)
+ w2-29099
+ (cons (car w2-29099)
+ (let ((m2-29116 (cdr w2-29099)))
+ (if (null? m2-29116)
+ s1-29101
+ (append
+ s1-29101
+ m2-29116)))))
+ (cons (let ((m2-29124 (car w2-29099)))
+ (if (null? m2-29124)
+ m1-29100
+ (append m1-29100 m2-29124)))
+ (let ((m2-29132 (cdr w2-29099)))
+ (if (null? m2-29132)
+ s1-29101
+ (append
+ s1-29101
+ m2-29132))))))))
+ (module-29092 (vector-ref x-29051 3)))
+ (vector
+ 'syntax-object
+ expression-29090
+ wrap-29091
+ module-29092))
+ (if (null? x-29051)
+ x-29051
+ (vector
+ 'syntax-object
+ x-29051
+ w-29046
+ mod-29037)))))))
(gensym
- (string-append "m-" (session-id-6510) "-")))))))
- (expand-body-6589
- (lambda (body-25134
- outer-form-25135
- r-25136
- w-25137
- mod-25138)
- (let ((r-25139
- (cons '("placeholder" placeholder) r-25136)))
- (let ((ribcage-25140 (vector 'ribcage '() '() '())))
- (let ((w-25141
- (cons (car w-25137)
- (cons ribcage-25140 (cdr w-25137)))))
+ (string-append "m-" (session-id-4511) "-")))))))
+ (expand-body-4590
+ (lambda (body-29393
+ outer-form-29394
+ r-29395
+ w-29396
+ mod-29397)
+ (let ((r-29398
+ (cons '("placeholder" placeholder) r-29395)))
+ (let ((ribcage-29399 (vector 'ribcage '() '() '())))
+ (let ((w-29400
+ (cons (car w-29396)
+ (cons ribcage-29399 (cdr w-29396)))))
(letrec*
- ((parse-25142
- (lambda (body-25155
- ids-25156
- labels-25157
- var-ids-25158
- vars-25159
- vals-25160
- bindings-25161)
- (if (null? body-25155)
+ ((parse-29401
+ (lambda (body-29509
+ ids-29510
+ labels-29511
+ var-ids-29512
+ vars-29513
+ vals-29514
+ bindings-29515)
+ (if (null? body-29509)
(syntax-violation
#f
"no expressions in body"
- outer-form-25135)
- (let ((e-25162 (cdr (car body-25155)))
- (er-25163 (car (car body-25155))))
+ outer-form-29394)
+ (let ((e-29516 (cdr (car body-29509)))
+ (er-29517 (car (car body-29509))))
(call-with-values
(lambda ()
- (syntax-type-6584
- e-25162
- er-25163
+ (syntax-type-4585
+ e-29516
+ er-29517
'(())
- (source-annotation-6542 er-25163)
- ribcage-25140
- mod-25138
+ (source-annotation-4544 er-29517)
+ ribcage-29399
+ mod-29397
#f))
- (lambda (type-25320
- value-25321
- form-25322
- e-25323
- w-25324
- s-25325
- mod-25326)
- (if (eqv? type-25320 'define-form)
- (let ((id-25330
- (wrap-6578
- value-25321
- w-25324
- mod-25326))
- (label-25331
+ (lambda (type-29705
+ value-29706
+ form-29707
+ e-29708
+ w-29709
+ s-29710
+ mod-29711)
+ (if (eqv? type-29705 'define-form)
+ (let ((id-29715
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ value-29706
+ (if (if (vector? value-29706)
+ (if (= (vector-length
+ value-29706)
+ 4)
+ (eq? (vector-ref
+ value-29706
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-29760
+ (vector-ref value-29706 1))
+ (wrap-29761
+ (let ((w2-29771
+ (vector-ref
+ value-29706
+ 2)))
+ (let ((m1-29772
+ (car w-29709))
+ (s1-29773
+ (cdr w-29709)))
+ (if (null? m1-29772)
+ (if (null? s1-29773)
+ w2-29771
+ (cons (car w2-29771)
+ (let ((m2-29790
+ (cdr w2-29771)))
+ (if (null? m2-29790)
+ s1-29773
+ (append
+ s1-29773
+ m2-29790)))))
+ (cons (let ((m2-29798
+ (car w2-29771)))
+ (if (null? m2-29798)
+ m1-29772
+ (append
+ m1-29772
+ m2-29798)))
+ (let ((m2-29806
+ (cdr w2-29771)))
+ (if (null? m2-29806)
+ s1-29773
+ (append
+ s1-29773
+ m2-29806))))))))
+ (module-29762
+ (vector-ref
+ value-29706
+ 3)))
+ (vector
+ 'syntax-object
+ expression-29760
+ wrap-29761
+ module-29762))
+ (if (null? value-29706)
+ value-29706
+ (vector
+ 'syntax-object
+ value-29706
+ w-29709
+ mod-29711)))))
+ (label-29716
(string-append
"l-"
- (session-id-6510)
+ (session-id-4511)
(symbol->string (gensym "-")))))
- (let ((var-25332
- (let ((id-25392
- (if (if (vector? id-25330)
+ (let ((var-29717
+ (let ((id-29867
+ (if (if (vector? id-29715)
(if (= (vector-length
- id-25330)
+ id-29715)
4)
(eq? (vector-ref
- id-25330
+ id-29715
0)
'syntax-object)
#f)
#f)
- (vector-ref id-25330 1)
- id-25330)))
+ (vector-ref id-29715 1)
+ id-29715)))
(gensym
(string-append
- (symbol->string id-25392)
+ (symbol->string id-29867)
"-")))))
(begin
- (let ((update-25382
- (cons (vector-ref id-25330 1)
- (vector-ref
- ribcage-25140
- 1))))
- (vector-set!
- ribcage-25140
- 1
- update-25382))
- (let ((update-25384
- (cons (car (vector-ref
- id-25330
- 2))
- (vector-ref
- ribcage-25140
- 2))))
- (vector-set!
- ribcage-25140
- 2
- update-25384))
- (let ((update-25386
- (cons label-25331
- (vector-ref
- ribcage-25140
- 3))))
- (vector-set!
- ribcage-25140
- 3
- update-25386))
- (parse-25142
- (cdr body-25155)
- (cons id-25330 ids-25156)
- (cons label-25331 labels-25157)
- (cons id-25330 var-ids-25158)
- (cons var-25332 vars-25159)
- (cons (cons er-25163
- (wrap-6578
- e-25323
- w-25324
- mod-25326))
- vals-25160)
- (cons (cons 'lexical var-25332)
- bindings-25161)))))
- (if (if (eqv? type-25320 'define-syntax-form)
+ (begin
+ (let ((update-29726
+ (cons (vector-ref id-29715 1)
+ (vector-ref
+ ribcage-29399
+ 1))))
+ (vector-set!
+ ribcage-29399
+ 1
+ update-29726))
+ (let ((update-29838
+ (cons (car (vector-ref
+ id-29715
+ 2))
+ (vector-ref
+ ribcage-29399
+ 2))))
+ (vector-set!
+ ribcage-29399
+ 2
+ update-29838))
+ (let ((update-29853
+ (cons label-29716
+ (vector-ref
+ ribcage-29399
+ 3))))
+ (vector-set!
+ ribcage-29399
+ 3
+ update-29853)))
+ (parse-29401
+ (cdr body-29509)
+ (cons id-29715 ids-29510)
+ (cons label-29716 labels-29511)
+ (cons id-29715 var-ids-29512)
+ (cons var-29717 vars-29513)
+ (cons (cons er-29517
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ e-29708
+ (if (if (vector? e-29708)
+ (if (= (vector-length
+ e-29708)
+ 4)
+ (eq? (vector-ref
+ e-29708
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-29919
+ (vector-ref
+ e-29708
+ 1))
+ (wrap-29920
+ (let ((w2-29930
+ (vector-ref
+ e-29708
+ 2)))
+ (let ((m1-29931
+ (car w-29709))
+ (s1-29932
+ (cdr w-29709)))
+ (if (null? m1-29931)
+ (if (null? s1-29932)
+ w2-29930
+ (cons (car w2-29930)
+ (let ((m2-29949
+ (cdr w2-29930)))
+ (if (null? m2-29949)
+ s1-29932
+ (append
+ s1-29932
+ m2-29949)))))
+ (cons (let ((m2-29957
+ (car w2-29930)))
+ (if (null? m2-29957)
+ m1-29931
+ (append
+ m1-29931
+ m2-29957)))
+ (let ((m2-29965
+ (cdr w2-29930)))
+ (if (null? m2-29965)
+ s1-29932
+ (append
+ s1-29932
+ m2-29965))))))))
+ (module-29921
+ (vector-ref
+ e-29708
+ 3)))
+ (vector
+ 'syntax-object
+ expression-29919
+ wrap-29920
+ module-29921))
+ (if (null? e-29708)
+ e-29708
+ (vector
+ 'syntax-object
+ e-29708
+ w-29709
+ mod-29711)))))
+ vals-29514)
+ (cons (cons 'lexical var-29717)
+ bindings-29515)))))
+ (if (if (eqv? type-29705 'define-syntax-form)
#t
- (eqv? type-25320
+ (eqv? type-29705
'define-syntax-parameter-form))
- (let ((id-25425
- (wrap-6578
- value-25321
- w-25324
- mod-25326))
- (label-25426
+ (let ((id-29996
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ value-29706
+ (if (if (vector? value-29706)
+ (if (= (vector-length
+ value-29706)
+ 4)
+ (eq? (vector-ref
+ value-29706
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-30040
+ (vector-ref
+ value-29706
+ 1))
+ (wrap-30041
+ (let ((w2-30051
+ (vector-ref
+ value-29706
+ 2)))
+ (let ((m1-30052
+ (car w-29709))
+ (s1-30053
+ (cdr w-29709)))
+ (if (null? m1-30052)
+ (if (null? s1-30053)
+ w2-30051
+ (cons (car w2-30051)
+ (let ((m2-30070
+ (cdr w2-30051)))
+ (if (null? m2-30070)
+ s1-30053
+ (append
+ s1-30053
+ m2-30070)))))
+ (cons (let ((m2-30078
+ (car w2-30051)))
+ (if (null? m2-30078)
+ m1-30052
+ (append
+ m1-30052
+ m2-30078)))
+ (let ((m2-30086
+ (cdr w2-30051)))
+ (if (null? m2-30086)
+ s1-30053
+ (append
+ s1-30053
+ m2-30086))))))))
+ (module-30042
+ (vector-ref
+ value-29706
+ 3)))
+ (vector
+ 'syntax-object
+ expression-30040
+ wrap-30041
+ module-30042))
+ (if (null? value-29706)
+ value-29706
+ (vector
+ 'syntax-object
+ value-29706
+ w-29709
+ mod-29711)))))
+ (label-29997
(string-append
"l-"
- (session-id-6510)
+ (session-id-4511)
(symbol->string (gensym "-")))))
(begin
- (let ((update-25476
- (cons (vector-ref id-25425 1)
- (vector-ref
- ribcage-25140
- 1))))
- (vector-set!
- ribcage-25140
- 1
- update-25476))
- (let ((update-25478
- (cons (car (vector-ref
- id-25425
- 2))
- (vector-ref
- ribcage-25140
- 2))))
- (vector-set!
- ribcage-25140
- 2
- update-25478))
- (let ((update-25480
- (cons label-25426
- (vector-ref
- ribcage-25140
- 3))))
- (vector-set!
- ribcage-25140
- 3
- update-25480))
- (parse-25142
- (cdr body-25155)
- (cons id-25425 ids-25156)
- (cons label-25426 labels-25157)
- var-ids-25158
- vars-25159
- vals-25160
- (cons (cons 'macro
- (cons er-25163
- (wrap-6578
- e-25323
- w-25324
- mod-25326)))
- bindings-25161))))
- (if (eqv? type-25320 'begin-form)
- (let ((tmp-25488
+ (begin
+ (let ((update-30006
+ (cons (vector-ref id-29996 1)
+ (vector-ref
+ ribcage-29399
+ 1))))
+ (vector-set!
+ ribcage-29399
+ 1
+ update-30006))
+ (let ((update-30118
+ (cons (car (vector-ref
+ id-29996
+ 2))
+ (vector-ref
+ ribcage-29399
+ 2))))
+ (vector-set!
+ ribcage-29399
+ 2
+ update-30118))
+ (let ((update-30133
+ (cons label-29997
+ (vector-ref
+ ribcage-29399
+ 3))))
+ (vector-set!
+ ribcage-29399
+ 3
+ update-30133)))
+ (parse-29401
+ (cdr body-29509)
+ (cons id-29996 ids-29510)
+ (cons label-29997 labels-29511)
+ var-ids-29512
+ vars-29513
+ vals-29514
+ (cons (cons (if (eq? type-29705
+ 'define-syntax-parameter-form)
+ 'syntax-parameter
+ 'macro)
+ (cons er-29517
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ e-29708
+ (if (if (vector?
+ e-29708)
+ (if (= (vector-length
+ e-29708)
+ 4)
+ (eq? (vector-ref
+ e-29708
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-30172
+ (vector-ref
+ e-29708
+ 1))
+ (wrap-30173
+ (let ((w2-30183
+ (vector-ref
+ e-29708
+ 2)))
+ (let ((m1-30184
+ (car w-29709))
+ (s1-30185
+ (cdr w-29709)))
+ (if (null? m1-30184)
+ (if (null? s1-30185)
+ w2-30183
+ (cons (car w2-30183)
+ (let ((m2-30202
+ (cdr w2-30183)))
+ (if (null? m2-30202)
+ s1-30185
+ (append
+ s1-30185
+ m2-30202)))))
+ (cons (let ((m2-30210
+ (car w2-30183)))
+ (if (null? m2-30210)
+ m1-30184
+ (append
+ m1-30184
+ m2-30210)))
+ (let ((m2-30218
+ (cdr w2-30183)))
+ (if (null? m2-30218)
+ s1-30185
+ (append
+ s1-30185
+ m2-30218))))))))
+ (module-30174
+ (vector-ref
+ e-29708
+ 3)))
+ (vector
+ 'syntax-object
+ expression-30172
+ wrap-30173
+ module-30174))
+ (if (null? e-29708)
+ e-29708
+ (vector
+ 'syntax-object
+ e-29708
+ w-29709
+ mod-29711))))))
+ bindings-29515))))
+ (if (eqv? type-29705 'begin-form)
+ (let ((tmp-30245
($sc-dispatch
- e-25323
+ e-29708
'(_ . each-any))))
- (if tmp-25488
+ (if tmp-30245
(@apply
- (lambda (e1-25492)
- (parse-25142
+ (lambda (e1-30249)
+ (parse-29401
(letrec*
- ((f-25493
- (lambda (forms-25556)
- (if (null? forms-25556)
- (cdr body-25155)
- (cons (cons er-25163
- (wrap-6578
- (car forms-25556)
- w-25324
- mod-25326))
- (f-25493
- (cdr forms-25556)))))))
- (f-25493 e1-25492))
- ids-25156
- labels-25157
- var-ids-25158
- vars-25159
- vals-25160
- bindings-25161))
- tmp-25488)
+ ((f-30250
+ (lambda (forms-30451)
+ (if (null? forms-30451)
+ (cdr body-29509)
+ (cons (cons er-29517
+ (let ((x-30455
+ (car forms-30451)))
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ x-30455
+ (if (if (vector?
+ x-30455)
+ (if (= (vector-length
+ x-30455)
+ 4)
+ (eq? (vector-ref
+ x-30455
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-30473
+ (vector-ref
+ x-30455
+ 1))
+ (wrap-30474
+ (let ((w2-30482
+ (vector-ref
+ x-30455
+ 2)))
+ (let ((m1-30483
+ (car w-29709))
+ (s1-30484
+ (cdr w-29709)))
+ (if (null? m1-30483)
+ (if (null? s1-30484)
+ w2-30482
+ (cons (car w2-30482)
+ (let ((m2-30499
+ (cdr w2-30482)))
+ (if (null? m2-30499)
+ s1-30484
+ (append
+ s1-30484
+ m2-30499)))))
+ (cons (let ((m2-30507
+ (car w2-30482)))
+ (if (null? m2-30507)
+ m1-30483
+ (append
+ m1-30483
+ m2-30507)))
+ (let ((m2-30515
+ (cdr w2-30482)))
+ (if (null? m2-30515)
+ s1-30484
+ (append
+ s1-30484
+ m2-30515))))))))
+ (module-30475
+ (vector-ref
+ x-30455
+ 3)))
+ (vector
+ 'syntax-object
+ expression-30473
+ wrap-30474
+ module-30475))
+ (if (null? x-30455)
+ x-30455
+ (vector
+ 'syntax-object
+ x-30455
+ w-29709
+ mod-29711))))))
+ (f-30250
+ (cdr forms-30451)))))))
+ (f-30250 e1-30249))
+ ids-29510
+ labels-29511
+ var-ids-29512
+ vars-29513
+ vals-29514
+ bindings-29515))
+ tmp-30245)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-25323)))
- (if (eqv? type-25320 'local-syntax-form)
- (expand-local-syntax-6590
- value-25321
- e-25323
- er-25163
- w-25324
- s-25325
- mod-25326
- (lambda (forms-25570
- er-25571
- w-25572
- s-25573
- mod-25574)
- (parse-25142
+ e-29708)))
+ (if (eqv? type-29705 'local-syntax-form)
+ (expand-local-syntax-4591
+ value-29706
+ e-29708
+ er-29517
+ w-29709
+ s-29710
+ mod-29711
+ (lambda (forms-30541
+ er-30542
+ w-30543
+ s-30544
+ mod-30545)
+ (parse-29401
(letrec*
- ((f-25575
- (lambda (forms-25638)
- (if (null? forms-25638)
- (cdr body-25155)
- (cons (cons er-25571
- (wrap-6578
- (car forms-25638)
- w-25572
- mod-25574))
- (f-25575
- (cdr forms-25638)))))))
- (f-25575 forms-25570))
- ids-25156
- labels-25157
- var-ids-25158
- vars-25159
- vals-25160
- bindings-25161)))
- (if (null? ids-25156)
- (build-sequence-6530
+ ((f-30546
+ (lambda (forms-30747)
+ (if (null? forms-30747)
+ (cdr body-29509)
+ (cons (cons er-30542
+ (let ((x-30751
+ (car forms-30747)))
+ (if (if (null? (car w-30543))
+ (null? (cdr w-30543))
+ #f)
+ x-30751
+ (if (if (vector?
+ x-30751)
+ (if (= (vector-length
+ x-30751)
+ 4)
+ (eq? (vector-ref
+ x-30751
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-30769
+ (vector-ref
+ x-30751
+ 1))
+ (wrap-30770
+ (let ((w2-30778
+ (vector-ref
+ x-30751
+ 2)))
+ (let ((m1-30779
+ (car w-30543))
+ (s1-30780
+ (cdr w-30543)))
+ (if (null? m1-30779)
+ (if (null? s1-30780)
+ w2-30778
+ (cons (car w2-30778)
+ (let ((m2-30795
+ (cdr w2-30778)))
+ (if (null? m2-30795)
+ s1-30780
+ (append
+ s1-30780
+ m2-30795)))))
+ (cons (let ((m2-30803
+ (car w2-30778)))
+ (if (null? m2-30803)
+ m1-30779
+ (append
+ m1-30779
+ m2-30803)))
+ (let ((m2-30811
+ (cdr w2-30778)))
+ (if (null? m2-30811)
+ s1-30780
+ (append
+ s1-30780
+ m2-30811))))))))
+ (module-30771
+ (vector-ref
+ x-30751
+ 3)))
+ (vector
+ 'syntax-object
+ expression-30769
+ wrap-30770
+ module-30771))
+ (if (null? x-30751)
+ x-30751
+ (vector
+ 'syntax-object
+ x-30751
+ w-30543
+ mod-30545))))))
+ (f-30546
+ (cdr forms-30747)))))))
+ (f-30546 forms-30541))
+ ids-29510
+ labels-29511
+ var-ids-29512
+ vars-29513
+ vals-29514
+ bindings-29515)))
+ (if (null? ids-29510)
+ (build-sequence-4532
#f
- (map (lambda (x-25703)
- (let ((e-25707 (cdr x-25703))
- (r-25708 (car x-25703)))
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-25707
- r-25708
- '(())
- (source-annotation-6542
- e-25707)
- #f
- mod-25326
- #f))
- (lambda (type-25712
- value-25713
- form-25714
- e-25715
- w-25716
- s-25717
- mod-25718)
- (expand-expr-6586
- type-25712
- value-25713
- form-25714
- e-25715
- r-25708
- w-25716
- s-25717
- mod-25718)))))
- (cons (cons er-25163
- (wrap-6578
- (begin
- (if (if (pair? e-25323)
- s-25325
+ (map (lambda (x-30896)
+ (expand-4586
+ (cdr x-30896)
+ (car x-30896)
+ '(())
+ mod-29711))
+ (cons (cons er-29517
+ (let ((x-30971
+ (begin
+ (if (if (pair? e-29708)
+ s-29710
+ #f)
+ (set-source-properties!
+ e-29708
+ s-29710))
+ e-29708)))
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ x-30971
+ (if (if (vector?
+ x-30971)
+ (if (= (vector-length
+ x-30971)
+ 4)
+ (eq? (vector-ref
+ x-30971
+ 0)
+ 'syntax-object)
+ #f)
#f)
- (set-source-properties!
- e-25323
- s-25325))
- e-25323)
- w-25324
- mod-25326))
- (cdr body-25155))))
+ (let ((expression-31003
+ (vector-ref
+ x-30971
+ 1))
+ (wrap-31004
+ (let ((w2-31012
+ (vector-ref
+ x-30971
+ 2)))
+ (let ((m1-31013
+ (car w-29709))
+ (s1-31014
+ (cdr w-29709)))
+ (if (null? m1-31013)
+ (if (null? s1-31014)
+ w2-31012
+ (cons (car w2-31012)
+ (let ((m2-31029
+ (cdr w2-31012)))
+ (if (null? m2-31029)
+ s1-31014
+ (append
+ s1-31014
+ m2-31029)))))
+ (cons (let ((m2-31037
+ (car w2-31012)))
+ (if (null? m2-31037)
+ m1-31013
+ (append
+ m1-31013
+ m2-31037)))
+ (let ((m2-31045
+ (cdr w2-31012)))
+ (if (null? m2-31045)
+ s1-31014
+ (append
+ s1-31014
+ m2-31045))))))))
+ (module-31005
+ (vector-ref
+ x-30971
+ 3)))
+ (vector
+ 'syntax-object
+ expression-31003
+ wrap-31004
+ module-31005))
+ (if (null? x-30971)
+ x-30971
+ (vector
+ 'syntax-object
+ x-30971
+ w-29709
+ mod-29711))))))
+ (cdr body-29509))))
(begin
- (if (not (valid-bound-ids?-6575
- ids-25156))
+ (if (not (valid-bound-ids?-4576
+ ids-29510))
(syntax-violation
#f
"invalid or duplicate identifier in definition"
- outer-form-25135))
+ outer-form-29394))
(letrec*
- ((loop-25819
- (lambda (bs-25822
- er-cache-25823
- r-cache-25824)
- (if (not (null? bs-25822))
- (let ((b-25825
- (car bs-25822)))
- (if (eq? (car b-25825)
- 'macro)
- (let ((er-25827
- (car (cdr b-25825))))
- (let ((r-cache-25828
- (if (eq? er-25827
- er-cache-25823)
- r-cache-25824
- (macros-only-env-6545
- er-25827))))
+ ((loop-31144
+ (lambda (bs-31147
+ er-cache-31148
+ r-cache-31149)
+ (if (not (null? bs-31147))
+ (let ((b-31150
+ (car bs-31147)))
+ (if (let ((t-31153
+ (car b-31150)))
+ (if (eq? t-31153
+ 'macro)
+ #t
+ (eq? t-31153
+ 'syntax-parameter)))
+ (let ((er-31155
+ (car (cdr b-31150))))
+ (let ((r-cache-31156
+ (if (eq? er-31155
+ er-cache-31148)
+ r-cache-31149
+ (macros-only-env-4547
+ er-31155))))
(begin
(set-cdr!
- b-25825
- (eval-local-transformer-6591
- (expand-6585
- (cdr (cdr b-25825))
- r-cache-25828
+ b-31150
+ (eval-local-transformer-4592
+ (expand-4586
+ (cdr (cdr b-31150))
+ r-cache-31156
'(())
- mod-25326)
- mod-25326))
- (loop-25819
- (cdr bs-25822)
- er-25827
- r-cache-25828))))
- (loop-25819
- (cdr bs-25822)
- er-cache-25823
- r-cache-25824)))))))
- (loop-25819 bindings-25161 #f #f))
+ mod-29711)
+ mod-29711))
+ (if (eq? (car b-31150)
+ 'syntax-parameter)
+ (set-cdr!
+ b-31150
+ (list (cdr b-31150))))
+ (loop-31144
+ (cdr bs-31147)
+ er-31155
+ r-cache-31156))))
+ (loop-31144
+ (cdr bs-31147)
+ er-cache-31148
+ r-cache-31149)))))))
+ (loop-31144 bindings-29515 #f #f))
(set-cdr!
- r-25139
- (extend-env-6543
- labels-25157
- bindings-25161
- (cdr r-25139)))
- (build-letrec-6533
+ r-29398
+ (extend-env-4545
+ labels-29511
+ bindings-29515
+ (cdr r-29398)))
+ (build-letrec-4535
#f
#t
(reverse
(map syntax->datum
- var-ids-25158))
- (reverse vars-25159)
- (map (lambda (x-26171)
- (let ((e-26175
- (cdr x-26171))
- (r-26176
- (car x-26171)))
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-26175
- r-26176
- '(())
- (source-annotation-6542
- e-26175)
- #f
- mod-25326
- #f))
- (lambda (type-26180
- value-26181
- form-26182
- e-26183
- w-26184
- s-26185
- mod-26186)
- (expand-expr-6586
- type-26180
- value-26181
- form-26182
- e-26183
- r-26176
- w-26184
- s-26185
- mod-26186)))))
- (reverse vals-25160))
- (let ((exps-26192
- (map (lambda (x-26193)
- (let ((e-26196
- (cdr x-26193))
- (r-26197
- (car x-26193)))
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-26196
- r-26197
- '(())
- (source-annotation-6542
- e-26196)
- #f
- mod-25326
- #f))
- (lambda (type-26201
- value-26202
- form-26203
- e-26204
- w-26205
- s-26206
- mod-26207)
- (expand-expr-6586
- type-26201
- value-26202
- form-26203
- e-26204
- r-26197
- w-26205
- s-26206
- mod-26207)))))
- (cons (cons er-25163
- (wrap-6578
+ var-ids-29512))
+ (reverse vars-29513)
+ (map (lambda (x-31576)
+ (expand-4586
+ (cdr x-31576)
+ (car x-31576)
+ '(())
+ mod-29711))
+ (reverse vals-29514))
+ (build-sequence-4532
+ #f
+ (map (lambda (x-31712)
+ (expand-4586
+ (cdr x-31712)
+ (car x-31712)
+ '(())
+ mod-29711))
+ (cons (cons er-29517
+ (let ((x-31787
(begin
- (if (if (pair? e-25323)
- s-25325
+ (if (if (pair? e-29708)
+ s-29710
#f)
(set-source-properties!
- e-25323
- s-25325))
- e-25323)
- w-25324
- mod-25326))
- (cdr body-25155)))))
- (if (null? (cdr exps-26192))
- (car exps-26192)
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 12)
- #f
- exps-26192)))))))))))))))))
- (parse-25142
- (map (lambda (x-25145)
- (cons r-25139
- (wrap-6578 x-25145 w-25141 mod-25138)))
- body-25134)
+ e-29708
+ s-29710))
+ e-29708)))
+ (if (if (null? (car w-29709))
+ (null? (cdr w-29709))
+ #f)
+ x-31787
+ (if (if (vector?
+ x-31787)
+ (if (= (vector-length
+ x-31787)
+ 4)
+ (eq? (vector-ref
+ x-31787
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-31819
+ (vector-ref
+ x-31787
+ 1))
+ (wrap-31820
+ (let ((w2-31828
+ (vector-ref
+ x-31787
+ 2)))
+ (let ((m1-31829
+ (car w-29709))
+ (s1-31830
+ (cdr w-29709)))
+ (if (null? m1-31829)
+ (if (null? s1-31830)
+ w2-31828
+ (cons (car w2-31828)
+ (let ((m2-31845
+ (cdr w2-31828)))
+ (if (null? m2-31845)
+ s1-31830
+ (append
+ s1-31830
+ m2-31845)))))
+ (cons (let ((m2-31853
+ (car w2-31828)))
+ (if (null? m2-31853)
+ m1-31829
+ (append
+ m1-31829
+ m2-31853)))
+ (let ((m2-31861
+ (cdr w2-31828)))
+ (if (null? m2-31861)
+ s1-31830
+ (append
+ s1-31830
+ m2-31861))))))))
+ (module-31821
+ (vector-ref
+ x-31787
+ 3)))
+ (vector
+ 'syntax-object
+ expression-31819
+ wrap-31820
+ module-31821))
+ (if (null? x-31787)
+ x-31787
+ (vector
+ 'syntax-object
+ x-31787
+ w-29709
+ mod-29711))))))
+ (cdr body-29509))))))))))))))))))
+ (parse-29401
+ (map (lambda (x-29404)
+ (cons r-29398
+ (if (if (null? (car w-29400))
+ (null? (cdr w-29400))
+ #f)
+ x-29404
+ (if (if (vector? x-29404)
+ (if (= (vector-length x-29404) 4)
+ (eq? (vector-ref x-29404 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-29440
+ (vector-ref x-29404 1))
+ (wrap-29441
+ (let ((w2-29451
+ (vector-ref x-29404 2)))
+ (let ((m1-29452 (car w-29400))
+ (s1-29453 (cdr w-29400)))
+ (if (null? m1-29452)
+ (if (null? s1-29453)
+ w2-29451
+ (cons (car w2-29451)
+ (let ((m2-29470
+ (cdr w2-29451)))
+ (if (null? m2-29470)
+ s1-29453
+ (append
+ s1-29453
+ m2-29470)))))
+ (cons (let ((m2-29478
+ (car w2-29451)))
+ (if (null? m2-29478)
+ m1-29452
+ (append
+ m1-29452
+ m2-29478)))
+ (let ((m2-29486
+ (cdr w2-29451)))
+ (if (null? m2-29486)
+ s1-29453
+ (append
+ s1-29453
+ m2-29486))))))))
+ (module-29442
+ (vector-ref x-29404 3)))
+ (vector
+ 'syntax-object
+ expression-29440
+ wrap-29441
+ module-29442))
+ (if (null? x-29404)
+ x-29404
+ (vector
+ 'syntax-object
+ x-29404
+ w-29400
+ mod-29397))))))
+ body-29393)
'()
'()
'()
'()
'()
'())))))))
- (expand-local-syntax-6590
- (lambda (rec?-26233
- e-26234
- r-26235
- w-26236
- s-26237
- mod-26238
- k-26239)
- (let ((tmp-26241
+ (expand-local-syntax-4591
+ (lambda (rec?-31876
+ e-31877
+ r-31878
+ w-31879
+ s-31880
+ mod-31881
+ k-31882)
+ (let ((tmp-31884
($sc-dispatch
- e-26234
+ e-31877
'(_ #(each (any any)) any . each-any))))
- (if tmp-26241
+ (if tmp-31884
(@apply
- (lambda (id-26245 val-26246 e1-26247 e2-26248)
- (if (not (valid-bound-ids?-6575 id-26245))
+ (lambda (id-31888 val-31889 e1-31890 e2-31891)
+ (if (not (valid-bound-ids?-4576 id-31888))
(syntax-violation
#f
"duplicate bound keyword"
- e-26234)
- (let ((labels-26338 (gen-labels-6552 id-26245)))
- (let ((new-w-26339
- (make-binding-wrap-6563
- id-26245
- labels-26338
- w-26236)))
- (k-26239
- (cons e1-26247 e2-26248)
- (extend-env-6543
- labels-26338
- (let ((trans-r-26375
- (macros-only-env-6545 r-26235)))
+ e-31877)
+ (let ((labels-31988 (gen-labels-4553 id-31888)))
+ (let ((new-w-31989
+ (make-binding-wrap-4564
+ id-31888
+ labels-31988
+ w-31879)))
+ (k-31882
+ (cons e1-31890 e2-31891)
+ (extend-env-4545
+ labels-31988
+ (let ((trans-r-32027
+ (macros-only-env-4547 r-31878)))
(begin
- (if rec?-26233 new-w-26339 w-26236)
- (map (lambda (x-26376)
+ (if rec?-31876 new-w-31989 w-31879)
+ (map (lambda (x-32028)
(cons 'macro
- (eval-local-transformer-6591
- (expand-6585
- x-26376
- trans-r-26375
+ (eval-local-transformer-4592
+ (expand-4586
+ x-32028
+ trans-r-32027
(values
- (if rec?-26233
- new-w-26339
- w-26236))
- mod-26238)
- mod-26238)))
- val-26246)))
- r-26235)
- new-w-26339
- s-26237
- mod-26238)))))
- tmp-26241)
+ (if rec?-31876
+ new-w-31989
+ w-31879))
+ mod-31881)
+ mod-31881)))
+ val-31889)))
+ r-31878)
+ new-w-31989
+ s-31880
+ mod-31881)))))
+ tmp-31884)
(syntax-violation
#f
"bad local syntax definition"
- (wrap-6578
- (begin
- (if (if (pair? e-26234) s-26237 #f)
- (set-source-properties! e-26234 s-26237))
- e-26234)
- w-26236
- mod-26238))))))
- (eval-local-transformer-6591
- (lambda (expanded-26656 mod-26657)
- (let ((p-26658 (primitive-eval expanded-26656)))
- (if (procedure? p-26658)
- p-26658
+ (let ((x-32335
+ (begin
+ (if (if (pair? e-31877) s-31880 #f)
+ (set-source-properties! e-31877 s-31880))
+ e-31877)))
+ (if (if (null? (car w-31879))
+ (null? (cdr w-31879))
+ #f)
+ x-32335
+ (if (if (vector? x-32335)
+ (if (= (vector-length x-32335) 4)
+ (eq? (vector-ref x-32335 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-32367 (vector-ref x-32335 1))
+ (wrap-32368
+ (let ((w2-32376 (vector-ref x-32335 2)))
+ (let ((m1-32377 (car w-31879))
+ (s1-32378 (cdr w-31879)))
+ (if (null? m1-32377)
+ (if (null? s1-32378)
+ w2-32376
+ (cons (car w2-32376)
+ (let ((m2-32393 (cdr w2-32376)))
+ (if (null? m2-32393)
+ s1-32378
+ (append s1-32378 m2-32393)))))
+ (cons (let ((m2-32401 (car w2-32376)))
+ (if (null? m2-32401)
+ m1-32377
+ (append m1-32377 m2-32401)))
+ (let ((m2-32409 (cdr w2-32376)))
+ (if (null? m2-32409)
+ s1-32378
+ (append s1-32378 m2-32409))))))))
+ (module-32369 (vector-ref x-32335 3)))
+ (vector
+ 'syntax-object
+ expression-32367
+ wrap-32368
+ module-32369))
+ (if (null? x-32335)
+ x-32335
+ (vector
+ 'syntax-object
+ x-32335
+ w-31879
+ mod-31881))))))))))
+ (eval-local-transformer-4592
+ (lambda (expanded-32427 mod-32428)
+ (let ((p-32429 (primitive-eval expanded-32427)))
+ (if (procedure? p-32429)
+ p-32429
(syntax-violation
#f
"nonprocedure transformer"
- p-26658)))))
- (ellipsis?-6593
- (lambda (x-7254)
- (if (if (if (vector? x-7254)
- (if (= (vector-length x-7254) 4)
- (eq? (vector-ref x-7254 0) 'syntax-object)
+ p-32429)))))
+ (ellipsis?-4594
+ (lambda (x-6134)
+ (if (if (if (vector? x-6134)
+ (if (= (vector-length x-6134) 4)
+ (eq? (vector-ref x-6134 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-7254 1))
+ (symbol? (vector-ref x-6134 1))
#f)
- (if (eq? (if (if (vector? x-7254)
- (if (= (vector-length x-7254) 4)
- (eq? (vector-ref x-7254 0) 'syntax-object)
- #f)
- #f)
- (vector-ref x-7254 1)
- x-7254)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098" "l-*-2097" "l-*-2096")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098" "l-*-2097" "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568 x-7254 '(()))
- (id-var-name-6568
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098" "l-*-2097" "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
+ (free-id=?-4574
+ x-6134
+ '#(syntax-object
+ ...
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-2416"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
#f)))
- (lambda-formals-6594
- (lambda (orig-args-26663)
+ (lambda-formals-4595
+ (lambda (orig-args-32434)
(letrec*
- ((req-26664
- (lambda (args-26668 rreq-26669)
- (let ((tmp-26671 ($sc-dispatch args-26668 '())))
- (if tmp-26671
+ ((req-32435
+ (lambda (args-32439 rreq-32440)
+ (let ((tmp-32442 ($sc-dispatch args-32439 '())))
+ (if tmp-32442
(@apply
- (lambda () (check-26665 (reverse rreq-26669) #f))
- tmp-26671)
- (let ((tmp-26794
- ($sc-dispatch args-26668 '(any . any))))
- (if (if tmp-26794
+ (lambda () (check-32436 (reverse rreq-32440) #f))
+ tmp-32442)
+ (let ((tmp-32558
+ ($sc-dispatch args-32439 '(any . any))))
+ (if (if tmp-32558
(@apply
- (lambda (a-26798 b-26799)
- (if (symbol? a-26798)
+ (lambda (a-32562 b-32563)
+ (if (symbol? a-32562)
#t
- (if (if (vector? a-26798)
- (if (= (vector-length a-26798) 4)
- (eq? (vector-ref a-26798 0)
+ (if (if (vector? a-32562)
+ (if (= (vector-length a-32562) 4)
+ (eq? (vector-ref a-32562 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-26798 1))
+ (symbol? (vector-ref a-32562 1))
#f)))
- tmp-26794)
+ tmp-32558)
#f)
(@apply
- (lambda (a-26826 b-26827)
- (req-26664 b-26827 (cons a-26826 rreq-26669)))
- tmp-26794)
- (let ((tmp-26828 (list args-26668)))
+ (lambda (a-32590 b-32591)
+ (req-32435 b-32591 (cons a-32590 rreq-32440)))
+ tmp-32558)
+ (let ((tmp-32592 (list args-32439)))
(if (@apply
- (lambda (r-26830)
- (if (symbol? r-26830)
+ (lambda (r-32594)
+ (if (symbol? r-32594)
#t
- (if (if (vector? r-26830)
- (if (= (vector-length r-26830) 4)
- (eq? (vector-ref r-26830 0)
+ (if (if (vector? r-32594)
+ (if (= (vector-length r-32594) 4)
+ (eq? (vector-ref r-32594 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-26830 1))
+ (symbol? (vector-ref r-32594 1))
#f)))
- tmp-26828)
+ tmp-32592)
(@apply
- (lambda (r-26860)
- (check-26665 (reverse rreq-26669) r-26860))
- tmp-26828)
+ (lambda (r-32624)
+ (check-32436 (reverse rreq-32440) r-32624))
+ tmp-32592)
(syntax-violation
'lambda
"invalid argument list"
- orig-args-26663
- args-26668)))))))))
- (check-26665
- (lambda (req-26991 rest-26992)
- (if (distinct-bound-ids?-6576
- (if rest-26992
- (cons rest-26992 req-26991)
- req-26991))
- (values req-26991 #f rest-26992 #f)
+ orig-args-32434
+ args-32439)))))))))
+ (check-32436
+ (lambda (req-32748 rest-32749)
+ (if (distinct-bound-ids?-4577
+ (if rest-32749
+ (cons rest-32749 req-32748)
+ req-32748))
+ (values req-32748 #f rest-32749 #f)
(syntax-violation
'lambda
"duplicate identifier in argument list"
- orig-args-26663)))))
- (req-26664 orig-args-26663 '()))))
- (expand-simple-lambda-6595
- (lambda (e-27108
- r-27109
- w-27110
- s-27111
- mod-27112
- req-27113
- rest-27114
- meta-27115
- body-27116)
- (let ((ids-27117
- (if rest-27114
- (append req-27113 (list rest-27114))
- req-27113)))
- (let ((vars-27118 (map gen-var-6599 ids-27117)))
- (let ((labels-27119 (gen-labels-6552 ids-27117)))
- (build-simple-lambda-6525
- s-27111
- (map syntax->datum req-27113)
- (if rest-27114 (syntax->datum rest-27114) #f)
- vars-27118
- meta-27115
- (expand-body-6589
- body-27116
- (wrap-6578
- (begin
- (if (if (pair? e-27108) s-27111 #f)
- (set-source-properties! e-27108 s-27111))
- e-27108)
- w-27110
- mod-27112)
- (extend-var-env-6544
- labels-27119
- vars-27118
- r-27109)
- (make-binding-wrap-6563
- ids-27117
- labels-27119
- w-27110)
- mod-27112)))))))
- (lambda*-formals-6596
- (lambda (orig-args-27399)
+ orig-args-32434)))))
+ (req-32435 orig-args-32434 '()))))
+ (expand-simple-lambda-4596
+ (lambda (e-32858
+ r-32859
+ w-32860
+ s-32861
+ mod-32862
+ req-32863
+ rest-32864
+ meta-32865
+ body-32866)
+ (let ((ids-32867
+ (if rest-32864
+ (append req-32863 (list rest-32864))
+ req-32863)))
+ (let ((vars-32868 (map gen-var-4600 ids-32867)))
+ (let ((labels-32869 (gen-labels-4553 ids-32867)))
+ (build-simple-lambda-4526
+ s-32861
+ (map syntax->datum req-32863)
+ (if rest-32864 (syntax->datum rest-32864) #f)
+ vars-32868
+ meta-32865
+ (expand-body-4590
+ body-32866
+ (let ((x-33052
+ (begin
+ (if (if (pair? e-32858) s-32861 #f)
+ (set-source-properties! e-32858 s-32861))
+ e-32858)))
+ (if (if (null? (car w-32860))
+ (null? (cdr w-32860))
+ #f)
+ x-33052
+ (if (if (vector? x-33052)
+ (if (= (vector-length x-33052) 4)
+ (eq? (vector-ref x-33052 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-33084 (vector-ref x-33052 1))
+ (wrap-33085
+ (let ((w2-33093 (vector-ref x-33052 2)))
+ (let ((m1-33094 (car w-32860))
+ (s1-33095 (cdr w-32860)))
+ (if (null? m1-33094)
+ (if (null? s1-33095)
+ w2-33093
+ (cons (car w2-33093)
+ (let ((m2-33110 (cdr w2-33093)))
+ (if (null? m2-33110)
+ s1-33095
+ (append
+ s1-33095
+ m2-33110)))))
+ (cons (let ((m2-33118 (car w2-33093)))
+ (if (null? m2-33118)
+ m1-33094
+ (append m1-33094 m2-33118)))
+ (let ((m2-33126 (cdr w2-33093)))
+ (if (null? m2-33126)
+ s1-33095
+ (append
+ s1-33095
+ m2-33126))))))))
+ (module-33086 (vector-ref x-33052 3)))
+ (vector
+ 'syntax-object
+ expression-33084
+ wrap-33085
+ module-33086))
+ (if (null? x-33052)
+ x-33052
+ (vector
+ 'syntax-object
+ x-33052
+ w-32860
+ mod-32862)))))
+ (extend-var-env-4546
+ labels-32869
+ vars-32868
+ r-32859)
+ (make-binding-wrap-4564
+ ids-32867
+ labels-32869
+ w-32860)
+ mod-32862)))))))
+ (lambda*-formals-4597
+ (lambda (orig-args-33335)
(letrec*
- ((req-27400
- (lambda (args-27407 rreq-27408)
- (let ((tmp-27410 ($sc-dispatch args-27407 '())))
- (if tmp-27410
+ ((req-33336
+ (lambda (args-33343 rreq-33344)
+ (let ((tmp-33346 ($sc-dispatch args-33343 '())))
+ (if tmp-33346
(@apply
(lambda ()
- (check-27404 (reverse rreq-27408) '() #f '()))
- tmp-27410)
- (let ((tmp-27416
- ($sc-dispatch args-27407 '(any . any))))
- (if (if tmp-27416
+ (check-33340 (reverse rreq-33344) '() #f '()))
+ tmp-33346)
+ (let ((tmp-33465
+ ($sc-dispatch args-33343 '(any . any))))
+ (if (if tmp-33465
(@apply
- (lambda (a-27420 b-27421)
- (if (symbol? a-27420)
+ (lambda (a-33469 b-33470)
+ (if (symbol? a-33469)
#t
- (if (if (vector? a-27420)
- (if (= (vector-length a-27420) 4)
- (eq? (vector-ref a-27420 0)
+ (if (if (vector? a-33469)
+ (if (= (vector-length a-33469) 4)
+ (eq? (vector-ref a-33469 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-27420 1))
+ (symbol? (vector-ref a-33469 1))
#f)))
- tmp-27416)
+ tmp-33465)
#f)
(@apply
- (lambda (a-27448 b-27449)
- (req-27400 b-27449 (cons a-27448 rreq-27408)))
- tmp-27416)
- (let ((tmp-27450
- ($sc-dispatch args-27407 '(any . any))))
- (if (if tmp-27450
+ (lambda (a-33497 b-33498)
+ (req-33336 b-33498 (cons a-33497 rreq-33344)))
+ tmp-33465)
+ (let ((tmp-33499
+ ($sc-dispatch args-33343 '(any . any))))
+ (if (if tmp-33499
(@apply
- (lambda (a-27454 b-27455)
- (eq? (syntax->datum a-27454) #:optional))
- tmp-27450)
+ (lambda (a-33503 b-33504)
+ (eq? (syntax->datum a-33503) #:optional))
+ tmp-33499)
#f)
(@apply
- (lambda (a-27456 b-27457)
- (opt-27401 b-27457 (reverse rreq-27408) '()))
- tmp-27450)
- (let ((tmp-27460
- ($sc-dispatch args-27407 '(any . any))))
- (if (if tmp-27460
+ (lambda (a-33505 b-33506)
+ (opt-33337 b-33506 (reverse rreq-33344) '()))
+ tmp-33499)
+ (let ((tmp-33509
+ ($sc-dispatch args-33343 '(any . any))))
+ (if (if tmp-33509
(@apply
- (lambda (a-27464 b-27465)
- (eq? (syntax->datum a-27464) #:key))
- tmp-27460)
+ (lambda (a-33513 b-33514)
+ (eq? (syntax->datum a-33513) #:key))
+ tmp-33509)
#f)
(@apply
- (lambda (a-27466 b-27467)
- (key-27402
- b-27467
- (reverse rreq-27408)
+ (lambda (a-33515 b-33516)
+ (key-33338
+ b-33516
+ (reverse rreq-33344)
'()
'()))
- tmp-27460)
- (let ((tmp-27470
- ($sc-dispatch args-27407 '(any any))))
- (if (if tmp-27470
+ tmp-33509)
+ (let ((tmp-33519
+ ($sc-dispatch args-33343 '(any any))))
+ (if (if tmp-33519
(@apply
- (lambda (a-27474 b-27475)
- (eq? (syntax->datum a-27474)
+ (lambda (a-33523 b-33524)
+ (eq? (syntax->datum a-33523)
#:rest))
- tmp-27470)
+ tmp-33519)
#f)
(@apply
- (lambda (a-27476 b-27477)
- (rest-27403
- b-27477
- (reverse rreq-27408)
+ (lambda (a-33525 b-33526)
+ (rest-33339
+ b-33526
+ (reverse rreq-33344)
'()
'()))
- tmp-27470)
- (let ((tmp-27480 (list args-27407)))
+ tmp-33519)
+ (let ((tmp-33529 (list args-33343)))
(if (@apply
- (lambda (r-27482)
- (if (symbol? r-27482)
+ (lambda (r-33531)
+ (if (symbol? r-33531)
#t
- (if (if (vector? r-27482)
+ (if (if (vector? r-33531)
(if (= (vector-length
- r-27482)
+ r-33531)
4)
(eq? (vector-ref
- r-27482
+ r-33531
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-27482 1))
+ (vector-ref r-33531 1))
#f)))
- tmp-27480)
+ tmp-33529)
(@apply
- (lambda (r-27512)
- (rest-27403
- r-27512
- (reverse rreq-27408)
+ (lambda (r-33561)
+ (rest-33339
+ r-33561
+ (reverse rreq-33344)
'()
'()))
- tmp-27480)
+ tmp-33529)
(syntax-violation
'lambda*
"invalid argument list"
- orig-args-27399
- args-27407)))))))))))))))
- (opt-27401
- (lambda (args-27531 req-27532 ropt-27533)
- (let ((tmp-27535 ($sc-dispatch args-27531 '())))
- (if tmp-27535
+ orig-args-33335
+ args-33343)))))))))))))))
+ (opt-33337
+ (lambda (args-33580 req-33581 ropt-33582)
+ (let ((tmp-33584 ($sc-dispatch args-33580 '())))
+ (if tmp-33584
(@apply
(lambda ()
- (check-27404
- req-27532
- (reverse ropt-27533)
+ (check-33340
+ req-33581
+ (reverse ropt-33582)
#f
'()))
- tmp-27535)
- (let ((tmp-27541
- ($sc-dispatch args-27531 '(any . any))))
- (if (if tmp-27541
+ tmp-33584)
+ (let ((tmp-33705
+ ($sc-dispatch args-33580 '(any . any))))
+ (if (if tmp-33705
(@apply
- (lambda (a-27545 b-27546)
- (if (symbol? a-27545)
+ (lambda (a-33709 b-33710)
+ (if (symbol? a-33709)
#t
- (if (if (vector? a-27545)
- (if (= (vector-length a-27545) 4)
- (eq? (vector-ref a-27545 0)
+ (if (if (vector? a-33709)
+ (if (= (vector-length a-33709) 4)
+ (eq? (vector-ref a-33709 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-27545 1))
+ (symbol? (vector-ref a-33709 1))
#f)))
- tmp-27541)
+ tmp-33705)
#f)
(@apply
- (lambda (a-27573 b-27574)
- (opt-27401
- b-27574
- req-27532
- (cons (cons a-27573
+ (lambda (a-33737 b-33738)
+ (opt-33337
+ b-33738
+ req-33581
+ (cons (cons a-33737
'(#(syntax-object
#f
((top)
#(ribcage
#(a b)
#((top) (top))
- #("l-*-4543" "l-*-4544"))
+ #("l-*-2555" "l-*-2556"))
#(ribcage () () ())
#(ribcage
#(args req ropt)
#((top) (top) (top))
- #("l-*-4533"
- "l-*-4534"
- "l-*-4535"))
+ #("l-*-2545"
+ "l-*-2546"
+ "l-*-2547"))
#(ribcage
(check rest key opt req)
((top)
@@ -6400,15 +7320,15 @@
(top)
(top)
(top))
- ("l-*-4479"
- "l-*-4477"
- "l-*-4475"
- "l-*-4473"
- "l-*-4471"))
+ ("l-*-2491"
+ "l-*-2489"
+ "l-*-2487"
+ "l-*-2485"
+ "l-*-2483"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-4470"))
+ #("l-*-2482"))
#(ribcage
(lambda-var-list
gen-var
@@ -6423,7 +7343,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -6479,7 +7399,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -6505,6 +7424,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -6516,7 +7436,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -6537,8 +7457,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -6689,286 +7610,287 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47" "l-*-46" "l-*-45"))
+ #(ribcage () () ()))
(hygiene guile))))
- ropt-27533)))
- tmp-27541)
- (let ((tmp-27575
- ($sc-dispatch args-27531 '((any any) . any))))
- (if (if tmp-27575
+ ropt-33582)))
+ tmp-33705)
+ (let ((tmp-33739
+ ($sc-dispatch args-33580 '((any any) . any))))
+ (if (if tmp-33739
(@apply
- (lambda (a-27579 init-27580 b-27581)
- (if (symbol? a-27579)
+ (lambda (a-33743 init-33744 b-33745)
+ (if (symbol? a-33743)
#t
- (if (if (vector? a-27579)
- (if (= (vector-length a-27579) 4)
- (eq? (vector-ref a-27579 0)
+ (if (if (vector? a-33743)
+ (if (= (vector-length a-33743) 4)
+ (eq? (vector-ref a-33743 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-27579 1))
+ (symbol? (vector-ref a-33743 1))
#f)))
- tmp-27575)
+ tmp-33739)
#f)
(@apply
- (lambda (a-27608 init-27609 b-27610)
- (opt-27401
- b-27610
- req-27532
- (cons (list a-27608 init-27609) ropt-27533)))
- tmp-27575)
- (let ((tmp-27611
- ($sc-dispatch args-27531 '(any . any))))
- (if (if tmp-27611
+ (lambda (a-33772 init-33773 b-33774)
+ (opt-33337
+ b-33774
+ req-33581
+ (cons (list a-33772 init-33773) ropt-33582)))
+ tmp-33739)
+ (let ((tmp-33775
+ ($sc-dispatch args-33580 '(any . any))))
+ (if (if tmp-33775
(@apply
- (lambda (a-27615 b-27616)
- (eq? (syntax->datum a-27615) #:key))
- tmp-27611)
+ (lambda (a-33779 b-33780)
+ (eq? (syntax->datum a-33779) #:key))
+ tmp-33775)
#f)
(@apply
- (lambda (a-27617 b-27618)
- (key-27402
- b-27618
- req-27532
- (reverse ropt-27533)
+ (lambda (a-33781 b-33782)
+ (key-33338
+ b-33782
+ req-33581
+ (reverse ropt-33582)
'()))
- tmp-27611)
- (let ((tmp-27621
- ($sc-dispatch args-27531 '(any any))))
- (if (if tmp-27621
+ tmp-33775)
+ (let ((tmp-33785
+ ($sc-dispatch args-33580 '(any any))))
+ (if (if tmp-33785
(@apply
- (lambda (a-27625 b-27626)
- (eq? (syntax->datum a-27625)
+ (lambda (a-33789 b-33790)
+ (eq? (syntax->datum a-33789)
#:rest))
- tmp-27621)
+ tmp-33785)
#f)
(@apply
- (lambda (a-27627 b-27628)
- (rest-27403
- b-27628
- req-27532
- (reverse ropt-27533)
+ (lambda (a-33791 b-33792)
+ (rest-33339
+ b-33792
+ req-33581
+ (reverse ropt-33582)
'()))
- tmp-27621)
- (let ((tmp-27631 (list args-27531)))
+ tmp-33785)
+ (let ((tmp-33795 (list args-33580)))
(if (@apply
- (lambda (r-27633)
- (if (symbol? r-27633)
+ (lambda (r-33797)
+ (if (symbol? r-33797)
#t
- (if (if (vector? r-27633)
+ (if (if (vector? r-33797)
(if (= (vector-length
- r-27633)
+ r-33797)
4)
(eq? (vector-ref
- r-27633
+ r-33797
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref r-27633 1))
+ (vector-ref r-33797 1))
#f)))
- tmp-27631)
+ tmp-33795)
(@apply
- (lambda (r-27663)
- (rest-27403
- r-27663
- req-27532
- (reverse ropt-27533)
+ (lambda (r-33827)
+ (rest-33339
+ r-33827
+ req-33581
+ (reverse ropt-33582)
'()))
- tmp-27631)
+ tmp-33795)
(syntax-violation
'lambda*
"invalid optional argument list"
- orig-args-27399
- args-27531)))))))))))))))
- (key-27402
- (lambda (args-27682 req-27683 opt-27684 rkey-27685)
- (let ((tmp-27687 ($sc-dispatch args-27682 '())))
- (if tmp-27687
+ orig-args-33335
+ args-33580)))))))))))))))
+ (key-33338
+ (lambda (args-33846 req-33847 opt-33848 rkey-33849)
+ (let ((tmp-33851 ($sc-dispatch args-33846 '())))
+ (if tmp-33851
(@apply
(lambda ()
- (check-27404
- req-27683
- opt-27684
+ (check-33340
+ req-33847
+ opt-33848
#f
- (cons #f (reverse rkey-27685))))
- tmp-27687)
- (let ((tmp-27693
- ($sc-dispatch args-27682 '(any . any))))
- (if (if tmp-27693
+ (cons #f (reverse rkey-33849))))
+ tmp-33851)
+ (let ((tmp-33973
+ ($sc-dispatch args-33846 '(any . any))))
+ (if (if tmp-33973
(@apply
- (lambda (a-27697 b-27698)
- (if (symbol? a-27697)
+ (lambda (a-33977 b-33978)
+ (if (symbol? a-33977)
#t
- (if (if (vector? a-27697)
- (if (= (vector-length a-27697) 4)
- (eq? (vector-ref a-27697 0)
+ (if (if (vector? a-33977)
+ (if (= (vector-length a-33977) 4)
+ (eq? (vector-ref a-33977 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-27697 1))
+ (symbol? (vector-ref a-33977 1))
#f)))
- tmp-27693)
+ tmp-33973)
#f)
(@apply
- (lambda (a-27725 b-27726)
- (let ((tmp-27727
- (symbol->keyword (syntax->datum a-27725))))
- (key-27402
- b-27726
- req-27683
- opt-27684
- (cons (cons tmp-27727
- (cons a-27725
+ (lambda (a-34005 b-34006)
+ (let ((tmp-34007
+ (symbol->keyword (syntax->datum a-34005))))
+ (key-33338
+ b-34006
+ req-33847
+ opt-33848
+ (cons (cons tmp-34007
+ (cons a-34005
'(#(syntax-object
#f
((top)
@@ -6976,12 +7898,12 @@
#(ribcage
#(k)
#((top))
- #("l-*-4606"))
+ #("l-*-2618"))
#(ribcage
#(a b)
#((top) (top))
- #("l-*-4600"
- "l-*-4601"))
+ #("l-*-2612"
+ "l-*-2613"))
#(ribcage () () ())
#(ribcage
#(args req opt rkey)
@@ -6989,10 +7911,10 @@
(top)
(top)
(top))
- #("l-*-4589"
- "l-*-4590"
- "l-*-4591"
- "l-*-4592"))
+ #("l-*-2601"
+ "l-*-2602"
+ "l-*-2603"
+ "l-*-2604"))
#(ribcage
(check rest
key
@@ -7003,15 +7925,15 @@
(top)
(top)
(top))
- ("l-*-4479"
- "l-*-4477"
- "l-*-4475"
- "l-*-4473"
- "l-*-4471"))
+ ("l-*-2491"
+ "l-*-2489"
+ "l-*-2487"
+ "l-*-2485"
+ "l-*-2483"))
#(ribcage
#(orig-args)
#((top))
- #("l-*-4470"))
+ #("l-*-2482"))
#(ribcage
(lambda-var-list
gen-var
@@ -7026,7 +7948,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -7082,7 +8004,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -7108,6 +8029,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -7119,7 +8041,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -7140,8 +8062,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -7292,876 +8215,1100 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47"
+ "l-*-46"
+ "l-*-45"))
+ #(ribcage () () ()))
(hygiene guile)))))
- rkey-27685))))
- tmp-27693)
- (let ((tmp-27730
- ($sc-dispatch args-27682 '((any any) . any))))
- (if (if tmp-27730
+ rkey-33849))))
+ tmp-33973)
+ (let ((tmp-34010
+ ($sc-dispatch args-33846 '((any any) . any))))
+ (if (if tmp-34010
(@apply
- (lambda (a-27734 init-27735 b-27736)
- (if (symbol? a-27734)
+ (lambda (a-34014 init-34015 b-34016)
+ (if (symbol? a-34014)
#t
- (if (if (vector? a-27734)
- (if (= (vector-length a-27734) 4)
- (eq? (vector-ref a-27734 0)
+ (if (if (vector? a-34014)
+ (if (= (vector-length a-34014) 4)
+ (eq? (vector-ref a-34014 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref a-27734 1))
+ (symbol? (vector-ref a-34014 1))
#f)))
- tmp-27730)
+ tmp-34010)
#f)
(@apply
- (lambda (a-27763 init-27764 b-27765)
- (let ((tmp-27766
+ (lambda (a-34043 init-34044 b-34045)
+ (let ((tmp-34046
(symbol->keyword
- (syntax->datum a-27763))))
- (key-27402
- b-27765
- req-27683
- opt-27684
- (cons (list tmp-27766 a-27763 init-27764)
- rkey-27685))))
- tmp-27730)
- (let ((tmp-27769
+ (syntax->datum a-34043))))
+ (key-33338
+ b-34045
+ req-33847
+ opt-33848
+ (cons (list tmp-34046 a-34043 init-34044)
+ rkey-33849))))
+ tmp-34010)
+ (let ((tmp-34049
($sc-dispatch
- args-27682
+ args-33846
'((any any any) . any))))
- (if (if tmp-27769
+ (if (if tmp-34049
(@apply
- (lambda (a-27773
- init-27774
- k-27775
- b-27776)
- (if (if (symbol? a-27773)
+ (lambda (a-34053
+ init-34054
+ k-34055
+ b-34056)
+ (if (if (symbol? a-34053)
#t
- (if (if (vector? a-27773)
+ (if (if (vector? a-34053)
(if (= (vector-length
- a-27773)
+ a-34053)
4)
(eq? (vector-ref
- a-27773
+ a-34053
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref a-27773 1))
+ (vector-ref a-34053 1))
#f))
- (keyword? (syntax->datum k-27775))
+ (keyword? (syntax->datum k-34055))
#f))
- tmp-27769)
+ tmp-34049)
#f)
(@apply
- (lambda (a-27803 init-27804 k-27805 b-27806)
- (key-27402
- b-27806
- req-27683
- opt-27684
- (cons (list k-27805 a-27803 init-27804)
- rkey-27685)))
- tmp-27769)
- (let ((tmp-27807
- ($sc-dispatch args-27682 '(any))))
- (if (if tmp-27807
+ (lambda (a-34083 init-34084 k-34085 b-34086)
+ (key-33338
+ b-34086
+ req-33847
+ opt-33848
+ (cons (list k-34085 a-34083 init-34084)
+ rkey-33849)))
+ tmp-34049)
+ (let ((tmp-34087
+ ($sc-dispatch args-33846 '(any))))
+ (if (if tmp-34087
(@apply
- (lambda (aok-27811)
- (eq? (syntax->datum aok-27811)
+ (lambda (aok-34091)
+ (eq? (syntax->datum aok-34091)
#:allow-other-keys))
- tmp-27807)
+ tmp-34087)
#f)
(@apply
- (lambda (aok-27812)
- (check-27404
- req-27683
- opt-27684
+ (lambda (aok-34092)
+ (check-33340
+ req-33847
+ opt-33848
#f
- (cons #t (reverse rkey-27685))))
- tmp-27807)
- (let ((tmp-27815
+ (cons #t (reverse rkey-33849))))
+ tmp-34087)
+ (let ((tmp-34211
($sc-dispatch
- args-27682
+ args-33846
'(any any any))))
- (if (if tmp-27815
+ (if (if tmp-34211
(@apply
- (lambda (aok-27819
- a-27820
- b-27821)
+ (lambda (aok-34215
+ a-34216
+ b-34217)
(if (eq? (syntax->datum
- aok-27819)
+ aok-34215)
#:allow-other-keys)
- (eq? (syntax->datum a-27820)
+ (eq? (syntax->datum a-34216)
#:rest)
#f))
- tmp-27815)
+ tmp-34211)
#f)
(@apply
- (lambda (aok-27822 a-27823 b-27824)
- (rest-27403
- b-27824
- req-27683
- opt-27684
- (cons #t (reverse rkey-27685))))
- tmp-27815)
- (let ((tmp-27827
+ (lambda (aok-34218 a-34219 b-34220)
+ (rest-33339
+ b-34220
+ req-33847
+ opt-33848
+ (cons #t (reverse rkey-33849))))
+ tmp-34211)
+ (let ((tmp-34223
($sc-dispatch
- args-27682
+ args-33846
'(any . any))))
- (if (if tmp-27827
+ (if (if tmp-34223
(@apply
- (lambda (aok-27831 r-27832)
+ (lambda (aok-34227 r-34228)
(if (eq? (syntax->datum
- aok-27831)
+ aok-34227)
#:allow-other-keys)
- (if (symbol? r-27832)
+ (if (symbol? r-34228)
#t
(if (if (vector?
- r-27832)
+ r-34228)
(if (= (vector-length
- r-27832)
+ r-34228)
4)
(eq? (vector-ref
- r-27832
+ r-34228
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-27832
+ r-34228
1))
#f))
#f))
- tmp-27827)
+ tmp-34223)
#f)
(@apply
- (lambda (aok-27859 r-27860)
- (rest-27403
- r-27860
- req-27683
- opt-27684
+ (lambda (aok-34255 r-34256)
+ (rest-33339
+ r-34256
+ req-33847
+ opt-33848
(cons #t
- (reverse rkey-27685))))
- tmp-27827)
- (let ((tmp-27863
+ (reverse rkey-33849))))
+ tmp-34223)
+ (let ((tmp-34259
($sc-dispatch
- args-27682
+ args-33846
'(any any))))
- (if (if tmp-27863
+ (if (if tmp-34259
(@apply
- (lambda (a-27867 b-27868)
+ (lambda (a-34263 b-34264)
(eq? (syntax->datum
- a-27867)
+ a-34263)
#:rest))
- tmp-27863)
+ tmp-34259)
#f)
(@apply
- (lambda (a-27869 b-27870)
- (rest-27403
- b-27870
- req-27683
- opt-27684
+ (lambda (a-34265 b-34266)
+ (rest-33339
+ b-34266
+ req-33847
+ opt-33848
(cons #f
(reverse
- rkey-27685))))
- tmp-27863)
- (let ((tmp-27873
- (list args-27682)))
+ rkey-33849))))
+ tmp-34259)
+ (let ((tmp-34269
+ (list args-33846)))
(if (@apply
- (lambda (r-27875)
- (if (symbol? r-27875)
+ (lambda (r-34271)
+ (if (symbol? r-34271)
#t
(if (if (vector?
- r-27875)
+ r-34271)
(if (= (vector-length
- r-27875)
+ r-34271)
4)
(eq? (vector-ref
- r-27875
+ r-34271
0)
'syntax-object)
#f)
#f)
(symbol?
(vector-ref
- r-27875
+ r-34271
1))
#f)))
- tmp-27873)
+ tmp-34269)
(@apply
- (lambda (r-27905)
- (rest-27403
- r-27905
- req-27683
- opt-27684
+ (lambda (r-34301)
+ (rest-33339
+ r-34301
+ req-33847
+ opt-33848
(cons #f
(reverse
- rkey-27685))))
- tmp-27873)
+ rkey-33849))))
+ tmp-34269)
(syntax-violation
'lambda*
"invalid keyword argument list"
- orig-args-27399
- args-27682)))))))))))))))))))))
- (rest-27403
- (lambda (args-27933 req-27934 opt-27935 kw-27936)
- (let ((tmp-27938 (list args-27933)))
+ orig-args-33335
+ args-33846)))))))))))))))))))))
+ (rest-33339
+ (lambda (args-34329 req-34330 opt-34331 kw-34332)
+ (let ((tmp-34334 (list args-34329)))
(if (@apply
- (lambda (r-27940)
- (if (symbol? r-27940)
+ (lambda (r-34336)
+ (if (symbol? r-34336)
#t
- (if (if (vector? r-27940)
- (if (= (vector-length r-27940) 4)
- (eq? (vector-ref r-27940 0) 'syntax-object)
+ (if (if (vector? r-34336)
+ (if (= (vector-length r-34336) 4)
+ (eq? (vector-ref r-34336 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref r-27940 1))
+ (symbol? (vector-ref r-34336 1))
#f)))
- tmp-27938)
+ tmp-34334)
(@apply
- (lambda (r-27970)
- (check-27404
- req-27934
- opt-27935
- r-27970
- kw-27936))
- tmp-27938)
+ (lambda (r-34366)
+ (check-33340
+ req-34330
+ opt-34331
+ r-34366
+ kw-34332))
+ tmp-34334)
(syntax-violation
'lambda*
"invalid rest argument"
- orig-args-27399
- args-27933)))))
- (check-27404
- (lambda (req-27974 opt-27975 rest-27976 kw-27977)
- (if (distinct-bound-ids?-6576
+ orig-args-33335
+ args-34329)))))
+ (check-33340
+ (lambda (req-34494 opt-34495 rest-34496 kw-34497)
+ (if (distinct-bound-ids?-4577
(append
- req-27974
- (map car opt-27975)
- (if rest-27976 (list rest-27976) '())
- (if (pair? kw-27977)
- (map cadr (cdr kw-27977))
+ req-34494
+ (map car opt-34495)
+ (if rest-34496 (list rest-34496) '())
+ (if (pair? kw-34497)
+ (map cadr (cdr kw-34497))
'())))
- (values req-27974 opt-27975 rest-27976 kw-27977)
+ (values req-34494 opt-34495 rest-34496 kw-34497)
(syntax-violation
'lambda*
"duplicate identifier in argument list"
- orig-args-27399)))))
- (req-27400 orig-args-27399 '()))))
- (expand-lambda-case-6597
- (lambda (e-28093
- r-28094
- w-28095
- s-28096
- mod-28097
- get-formals-28098
- clauses-28099)
+ orig-args-33335)))))
+ (req-33336 orig-args-33335 '()))))
+ (expand-lambda-case-4598
+ (lambda (e-34606
+ r-34607
+ w-34608
+ s-34609
+ mod-34610
+ get-formals-34611
+ clauses-34612)
(letrec*
- ((parse-req-28100
- (lambda (req-28231
- opt-28232
- rest-28233
- kw-28234
- body-28235)
- (let ((vars-28236 (map gen-var-6599 req-28231))
- (labels-28237 (gen-labels-6552 req-28231)))
- (let ((r*-28238
- (extend-var-env-6544
- labels-28237
- vars-28236
- r-28094))
- (w*-28239
- (make-binding-wrap-6563
- req-28231
- labels-28237
- w-28095)))
- (parse-opt-28101
- (map syntax->datum req-28231)
- opt-28232
- rest-28233
- kw-28234
- body-28235
- (reverse vars-28236)
- r*-28238
- w*-28239
+ ((parse-req-34613
+ (lambda (req-34746
+ opt-34747
+ rest-34748
+ kw-34749
+ body-34750)
+ (let ((vars-34751 (map gen-var-4600 req-34746))
+ (labels-34752 (gen-labels-4553 req-34746)))
+ (let ((r*-34753
+ (extend-var-env-4546
+ labels-34752
+ vars-34751
+ r-34607))
+ (w*-34754
+ (make-binding-wrap-4564
+ req-34746
+ labels-34752
+ w-34608)))
+ (parse-opt-34614
+ (map syntax->datum req-34746)
+ opt-34747
+ rest-34748
+ kw-34749
+ body-34750
+ (reverse vars-34751)
+ r*-34753
+ w*-34754
'()
'())))))
- (parse-opt-28101
- (lambda (req-28425
- opt-28426
- rest-28427
- kw-28428
- body-28429
- vars-28430
- r*-28431
- w*-28432
- out-28433
- inits-28434)
- (if (pair? opt-28426)
- (let ((tmp-28435 (car opt-28426)))
- (let ((tmp-28436 ($sc-dispatch tmp-28435 '(any any))))
- (if tmp-28436
+ (parse-opt-34614
+ (lambda (req-34951
+ opt-34952
+ rest-34953
+ kw-34954
+ body-34955
+ vars-34956
+ r*-34957
+ w*-34958
+ out-34959
+ inits-34960)
+ (if (pair? opt-34952)
+ (let ((tmp-34961 (car opt-34952)))
+ (let ((tmp-34962 ($sc-dispatch tmp-34961 '(any any))))
+ (if tmp-34962
(@apply
- (lambda (id-28438 i-28439)
- (let ((v-28440
- (let ((id-28448
- (if (if (vector? id-28438)
+ (lambda (id-34964 i-34965)
+ (let ((v-34966
+ (let ((id-34974
+ (if (if (vector? id-34964)
(if (= (vector-length
- id-28438)
+ id-34964)
4)
(eq? (vector-ref
- id-28438
+ id-34964
0)
'syntax-object)
#f)
#f)
- (vector-ref id-28438 1)
- id-28438)))
+ (vector-ref id-34964 1)
+ id-34964)))
(gensym
(string-append
- (symbol->string id-28448)
+ (symbol->string id-34974)
"-")))))
- (let ((l-28441 (gen-labels-6552 (list v-28440))))
- (let ((r**-28442
- (extend-var-env-6544
- l-28441
- (list v-28440)
- r*-28431)))
- (let ((w**-28443
- (make-binding-wrap-6563
- (list id-28438)
- l-28441
- w*-28432)))
- (parse-opt-28101
- req-28425
- (cdr opt-28426)
- rest-28427
- kw-28428
- body-28429
- (cons v-28440 vars-28430)
- r**-28442
- w**-28443
- (cons (syntax->datum id-28438) out-28433)
- (cons (expand-6585
- i-28439
- r*-28431
- w*-28432
- mod-28097)
- inits-28434)))))))
- tmp-28436)
+ (let ((l-34967 (gen-labels-4553 (list v-34966))))
+ (let ((r**-34968
+ (extend-var-env-4546
+ l-34967
+ (list v-34966)
+ r*-34957)))
+ (let ((w**-34969
+ (make-binding-wrap-4564
+ (list id-34964)
+ l-34967
+ w*-34958)))
+ (parse-opt-34614
+ req-34951
+ (cdr opt-34952)
+ rest-34953
+ kw-34954
+ body-34955
+ (cons v-34966 vars-34956)
+ r**-34968
+ w**-34969
+ (cons (syntax->datum id-34964) out-34959)
+ (cons (expand-4586
+ i-34965
+ r*-34957
+ w*-34958
+ mod-34610)
+ inits-34960)))))))
+ tmp-34962)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28435))))
- (if rest-28427
- (let ((v-28686
- (let ((id-28696
- (if (if (vector? rest-28427)
- (if (= (vector-length rest-28427) 4)
- (eq? (vector-ref rest-28427 0)
+ tmp-34961))))
+ (if rest-34953
+ (let ((v-35232
+ (let ((id-35242
+ (if (if (vector? rest-34953)
+ (if (= (vector-length rest-34953) 4)
+ (eq? (vector-ref rest-34953 0)
'syntax-object)
#f)
#f)
- (vector-ref rest-28427 1)
- rest-28427)))
+ (vector-ref rest-34953 1)
+ rest-34953)))
(gensym
(string-append
- (symbol->string id-28696)
+ (symbol->string id-35242)
"-")))))
- (let ((l-28687 (gen-labels-6552 (list v-28686))))
- (let ((r*-28688
- (extend-var-env-6544
- l-28687
- (list v-28686)
- r*-28431)))
- (let ((w*-28689
- (make-binding-wrap-6563
- (list rest-28427)
- l-28687
- w*-28432)))
- (parse-kw-28102
- req-28425
- (if (pair? out-28433) (reverse out-28433) #f)
- (syntax->datum rest-28427)
- (if (pair? kw-28428) (cdr kw-28428) kw-28428)
- body-28429
- (cons v-28686 vars-28430)
- r*-28688
- w*-28689
- (if (pair? kw-28428) (car kw-28428) #f)
+ (let ((l-35233 (gen-labels-4553 (list v-35232))))
+ (let ((r*-35234
+ (extend-var-env-4546
+ l-35233
+ (list v-35232)
+ r*-34957)))
+ (let ((w*-35235
+ (make-binding-wrap-4564
+ (list rest-34953)
+ l-35233
+ w*-34958)))
+ (parse-kw-34615
+ req-34951
+ (if (pair? out-34959) (reverse out-34959) #f)
+ (syntax->datum rest-34953)
+ (if (pair? kw-34954) (cdr kw-34954) kw-34954)
+ body-34955
+ (cons v-35232 vars-34956)
+ r*-35234
+ w*-35235
+ (if (pair? kw-34954) (car kw-34954) #f)
'()
- inits-28434)))))
- (parse-kw-28102
- req-28425
- (if (pair? out-28433) (reverse out-28433) #f)
+ inits-34960)))))
+ (parse-kw-34615
+ req-34951
+ (if (pair? out-34959) (reverse out-34959) #f)
#f
- (if (pair? kw-28428) (cdr kw-28428) kw-28428)
- body-28429
- vars-28430
- r*-28431
- w*-28432
- (if (pair? kw-28428) (car kw-28428) #f)
+ (if (pair? kw-34954) (cdr kw-34954) kw-34954)
+ body-34955
+ vars-34956
+ r*-34957
+ w*-34958
+ (if (pair? kw-34954) (car kw-34954) #f)
'()
- inits-28434)))))
- (parse-kw-28102
- (lambda (req-28867
- opt-28868
- rest-28869
- kw-28870
- body-28871
- vars-28872
- r*-28873
- w*-28874
- aok-28875
- out-28876
- inits-28877)
- (if (pair? kw-28870)
- (let ((tmp-28878 (car kw-28870)))
- (let ((tmp-28879
- ($sc-dispatch tmp-28878 '(any any any))))
- (if tmp-28879
+ inits-34960)))))
+ (parse-kw-34615
+ (lambda (req-35425
+ opt-35426
+ rest-35427
+ kw-35428
+ body-35429
+ vars-35430
+ r*-35431
+ w*-35432
+ aok-35433
+ out-35434
+ inits-35435)
+ (if (pair? kw-35428)
+ (let ((tmp-35436 (car kw-35428)))
+ (let ((tmp-35437
+ ($sc-dispatch tmp-35436 '(any any any))))
+ (if tmp-35437
(@apply
- (lambda (k-28881 id-28882 i-28883)
- (let ((v-28884
- (let ((id-28892
- (if (if (vector? id-28882)
+ (lambda (k-35439 id-35440 i-35441)
+ (let ((v-35442
+ (let ((id-35450
+ (if (if (vector? id-35440)
(if (= (vector-length
- id-28882)
+ id-35440)
4)
(eq? (vector-ref
- id-28882
+ id-35440
0)
'syntax-object)
#f)
#f)
- (vector-ref id-28882 1)
- id-28882)))
+ (vector-ref id-35440 1)
+ id-35440)))
(gensym
(string-append
- (symbol->string id-28892)
+ (symbol->string id-35450)
"-")))))
- (let ((l-28885 (gen-labels-6552 (list v-28884))))
- (let ((r**-28886
- (extend-var-env-6544
- l-28885
- (list v-28884)
- r*-28873)))
- (let ((w**-28887
- (make-binding-wrap-6563
- (list id-28882)
- l-28885
- w*-28874)))
- (parse-kw-28102
- req-28867
- opt-28868
- rest-28869
- (cdr kw-28870)
- body-28871
- (cons v-28884 vars-28872)
- r**-28886
- w**-28887
- aok-28875
- (cons (list (syntax->datum k-28881)
- (syntax->datum id-28882)
- v-28884)
- out-28876)
- (cons (expand-6585
- i-28883
- r*-28873
- w*-28874
- mod-28097)
- inits-28877)))))))
- tmp-28879)
+ (let ((l-35443 (gen-labels-4553 (list v-35442))))
+ (let ((r**-35444
+ (extend-var-env-4546
+ l-35443
+ (list v-35442)
+ r*-35431)))
+ (let ((w**-35445
+ (make-binding-wrap-4564
+ (list id-35440)
+ l-35443
+ w*-35432)))
+ (parse-kw-34615
+ req-35425
+ opt-35426
+ rest-35427
+ (cdr kw-35428)
+ body-35429
+ (cons v-35442 vars-35430)
+ r**-35444
+ w**-35445
+ aok-35433
+ (cons (list (syntax->datum k-35439)
+ (syntax->datum id-35440)
+ v-35442)
+ out-35434)
+ (cons (expand-4586
+ i-35441
+ r*-35431
+ w*-35432
+ mod-34610)
+ inits-35435)))))))
+ tmp-35437)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-28878))))
- (parse-body-28103
- req-28867
- opt-28868
- rest-28869
- (if (if aok-28875 aok-28875 (pair? out-28876))
- (cons aok-28875 (reverse out-28876))
+ tmp-35436))))
+ (parse-body-34616
+ req-35425
+ opt-35426
+ rest-35427
+ (if (if aok-35433 aok-35433 (pair? out-35434))
+ (cons aok-35433 (reverse out-35434))
#f)
- body-28871
- (reverse vars-28872)
- r*-28873
- w*-28874
- (reverse inits-28877)
+ body-35429
+ (reverse vars-35430)
+ r*-35431
+ w*-35432
+ (reverse inits-35435)
'()))))
- (parse-body-28103
- (lambda (req-29139
- opt-29140
- rest-29141
- kw-29142
- body-29143
- vars-29144
- r*-29145
- w*-29146
- inits-29147
- meta-29148)
- (let ((tmp-29150
- ($sc-dispatch body-29143 '(any any . each-any))))
- (if (if tmp-29150
+ (parse-body-34616
+ (lambda (req-35717
+ opt-35718
+ rest-35719
+ kw-35720
+ body-35721
+ vars-35722
+ r*-35723
+ w*-35724
+ inits-35725
+ meta-35726)
+ (let ((tmp-35728
+ ($sc-dispatch body-35721 '(any any . each-any))))
+ (if (if tmp-35728
(@apply
- (lambda (docstring-29154 e1-29155 e2-29156)
- (string? (syntax->datum docstring-29154)))
- tmp-29150)
+ (lambda (docstring-35732 e1-35733 e2-35734)
+ (string? (syntax->datum docstring-35732)))
+ tmp-35728)
#f)
(@apply
- (lambda (docstring-29157 e1-29158 e2-29159)
- (parse-body-28103
- req-29139
- opt-29140
- rest-29141
- kw-29142
- (cons e1-29158 e2-29159)
- vars-29144
- r*-29145
- w*-29146
- inits-29147
+ (lambda (docstring-35735 e1-35736 e2-35737)
+ (parse-body-34616
+ req-35717
+ opt-35718
+ rest-35719
+ kw-35720
+ (cons e1-35736 e2-35737)
+ vars-35722
+ r*-35723
+ w*-35724
+ inits-35725
(append
- meta-29148
+ meta-35726
(list (cons 'documentation
- (syntax->datum docstring-29157))))))
- tmp-29150)
- (let ((tmp-29160
+ (syntax->datum docstring-35735))))))
+ tmp-35728)
+ (let ((tmp-35738
($sc-dispatch
- body-29143
+ body-35721
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-29160
+ (if tmp-35738
(@apply
- (lambda (k-29164 v-29165 e1-29166 e2-29167)
- (parse-body-28103
- req-29139
- opt-29140
- rest-29141
- kw-29142
- (cons e1-29166 e2-29167)
- vars-29144
- r*-29145
- w*-29146
- inits-29147
+ (lambda (k-35742 v-35743 e1-35744 e2-35745)
+ (parse-body-34616
+ req-35717
+ opt-35718
+ rest-35719
+ kw-35720
+ (cons e1-35744 e2-35745)
+ vars-35722
+ r*-35723
+ w*-35724
+ inits-35725
(append
- meta-29148
- (syntax->datum (map cons k-29164 v-29165)))))
- tmp-29160)
- (let ((tmp-29168
- ($sc-dispatch body-29143 '(any . each-any))))
- (if tmp-29168
+ meta-35726
+ (syntax->datum (map cons k-35742 v-35743)))))
+ tmp-35738)
+ (let ((tmp-35746
+ ($sc-dispatch body-35721 '(any . each-any))))
+ (if tmp-35746
(@apply
- (lambda (e1-29172 e2-29173)
+ (lambda (e1-35750 e2-35751)
(values
- meta-29148
- req-29139
- opt-29140
- rest-29141
- kw-29142
- inits-29147
- vars-29144
- (expand-body-6589
- (cons e1-29172 e2-29173)
- (wrap-6578
- (begin
- (if (if (pair? e-28093) s-28096 #f)
- (set-source-properties!
- e-28093
- s-28096))
- e-28093)
- w-28095
- mod-28097)
- r*-29145
- w*-29146
- mod-28097)))
- tmp-29168)
+ meta-35726
+ req-35717
+ opt-35718
+ rest-35719
+ kw-35720
+ inits-35725
+ vars-35722
+ (expand-body-4590
+ (cons e1-35750 e2-35751)
+ (let ((x-35763
+ (begin
+ (if (if (pair? e-34606)
+ s-34609
+ #f)
+ (set-source-properties!
+ e-34606
+ s-34609))
+ e-34606)))
+ (if (if (null? (car w-34608))
+ (null? (cdr w-34608))
+ #f)
+ x-35763
+ (if (if (vector? x-35763)
+ (if (= (vector-length x-35763) 4)
+ (eq? (vector-ref x-35763 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-35795
+ (vector-ref x-35763 1))
+ (wrap-35796
+ (let ((w2-35804
+ (vector-ref
+ x-35763
+ 2)))
+ (let ((m1-35805
+ (car w-34608))
+ (s1-35806
+ (cdr w-34608)))
+ (if (null? m1-35805)
+ (if (null? s1-35806)
+ w2-35804
+ (cons (car w2-35804)
+ (let ((m2-35821
+ (cdr w2-35804)))
+ (if (null? m2-35821)
+ s1-35806
+ (append
+ s1-35806
+ m2-35821)))))
+ (cons (let ((m2-35829
+ (car w2-35804)))
+ (if (null? m2-35829)
+ m1-35805
+ (append
+ m1-35805
+ m2-35829)))
+ (let ((m2-35837
+ (cdr w2-35804)))
+ (if (null? m2-35837)
+ s1-35806
+ (append
+ s1-35806
+ m2-35837))))))))
+ (module-35797
+ (vector-ref x-35763 3)))
+ (vector
+ 'syntax-object
+ expression-35795
+ wrap-35796
+ module-35797))
+ (if (null? x-35763)
+ x-35763
+ (vector
+ 'syntax-object
+ x-35763
+ w-34608
+ mod-34610)))))
+ r*-35723
+ w*-35724
+ mod-34610)))
+ tmp-35746)
(syntax-violation
#f
"source expression failed to match any pattern"
- body-29143))))))))))
- (let ((tmp-28105 ($sc-dispatch clauses-28099 '())))
- (if tmp-28105
- (@apply (lambda () (values '() #f)) tmp-28105)
- (let ((tmp-28109
+ body-35721))))))))))
+ (let ((tmp-34618 ($sc-dispatch clauses-34612 '())))
+ (if tmp-34618
+ (@apply (lambda () (values '() #f)) tmp-34618)
+ (let ((tmp-34622
($sc-dispatch
- clauses-28099
+ clauses-34612
'((any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-28109
+ (if tmp-34622
(@apply
- (lambda (args-28113
- e1-28114
- e2-28115
- args*-28116
- e1*-28117
- e2*-28118)
+ (lambda (args-34626
+ e1-34627
+ e2-34628
+ args*-34629
+ e1*-34630
+ e2*-34631)
(call-with-values
- (lambda () (get-formals-28098 args-28113))
- (lambda (req-28119 opt-28120 rest-28121 kw-28122)
+ (lambda () (get-formals-34611 args-34626))
+ (lambda (req-34632 opt-34633 rest-34634 kw-34635)
(call-with-values
(lambda ()
- (parse-req-28100
- req-28119
- opt-28120
- rest-28121
- kw-28122
- (cons e1-28114 e2-28115)))
- (lambda (meta-28187
- req-28188
- opt-28189
- rest-28190
- kw-28191
- inits-28192
- vars-28193
- body-28194)
+ (parse-req-34613
+ req-34632
+ opt-34633
+ rest-34634
+ kw-34635
+ (cons e1-34627 e2-34628)))
+ (lambda (meta-34702
+ req-34703
+ opt-34704
+ rest-34705
+ kw-34706
+ inits-34707
+ vars-34708
+ body-34709)
(call-with-values
(lambda ()
- (expand-lambda-case-6597
- e-28093
- r-28094
- w-28095
- s-28096
- mod-28097
- get-formals-28098
- (map (lambda (tmp-4949-28195
- tmp-4948-28196
- tmp-4947-28197)
- (cons tmp-4947-28197
- (cons tmp-4948-28196
- tmp-4949-28195)))
- e2*-28118
- e1*-28117
- args*-28116)))
- (lambda (meta*-28198 else*-28199)
+ (expand-lambda-case-4598
+ e-34606
+ r-34607
+ w-34608
+ s-34609
+ mod-34610
+ get-formals-34611
+ (map (lambda (tmp-2961-34710
+ tmp-2960-34711
+ tmp-2959-34712)
+ (cons tmp-2959-34712
+ (cons tmp-2960-34711
+ tmp-2961-34710)))
+ e2*-34631
+ e1*-34630
+ args*-34629)))
+ (lambda (meta*-34713 else*-34714)
(values
- (append meta-28187 meta*-28198)
+ (append meta-34702 meta*-34713)
(make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- s-28096
- req-28188
- opt-28189
- rest-28190
- kw-28191
- inits-28192
- vars-28193
- body-28194
- else*-28199)))))))))
- tmp-28109)
+ (vector-ref %expanded-vtables 15)
+ s-34609
+ req-34703
+ opt-34704
+ rest-34705
+ kw-34706
+ inits-34707
+ vars-34708
+ body-34709
+ else*-34714)))))))))
+ tmp-34622)
(syntax-violation
#f
"source expression failed to match any pattern"
- clauses-28099))))))))
- (strip-6598
- (lambda (x-29210 w-29211)
- (if (memq 'top (car w-29211))
- x-29210
+ clauses-34612))))))))
+ (strip-4599
+ (lambda (x-35864 w-35865)
+ (if (memq 'top (car w-35865))
+ x-35864
(letrec*
- ((f-29212
- (lambda (x-29215)
- (if (if (vector? x-29215)
- (if (= (vector-length x-29215) 4)
- (eq? (vector-ref x-29215 0) 'syntax-object)
+ ((f-35866
+ (lambda (x-35869)
+ (if (if (vector? x-35869)
+ (if (= (vector-length x-35869) 4)
+ (eq? (vector-ref x-35869 0) 'syntax-object)
#f)
#f)
- (strip-6598
- (vector-ref x-29215 1)
- (vector-ref x-29215 2))
- (if (pair? x-29215)
- (let ((a-29234 (f-29212 (car x-29215)))
- (d-29235 (f-29212 (cdr x-29215))))
- (if (if (eq? a-29234 (car x-29215))
- (eq? d-29235 (cdr x-29215))
+ (strip-4599
+ (vector-ref x-35869 1)
+ (vector-ref x-35869 2))
+ (if (pair? x-35869)
+ (let ((a-35888 (f-35866 (car x-35869)))
+ (d-35889 (f-35866 (cdr x-35869))))
+ (if (if (eq? a-35888 (car x-35869))
+ (eq? d-35889 (cdr x-35869))
#f)
- x-29215
- (cons a-29234 d-29235)))
- (if (vector? x-29215)
- (let ((old-29238 (vector->list x-29215)))
- (let ((new-29239 (map f-29212 old-29238)))
+ x-35869
+ (cons a-35888 d-35889)))
+ (if (vector? x-35869)
+ (let ((old-35892 (vector->list x-35869)))
+ (let ((new-35893 (map f-35866 old-35892)))
(letrec*
- ((lp-29240
- (lambda (l1-29316 l2-29317)
- (if (null? l1-29316)
- x-29215
- (if (eq? (car l1-29316) (car l2-29317))
- (lp-29240 (cdr l1-29316) (cdr l2-29317))
- (list->vector new-29239))))))
- (lp-29240 old-29238 new-29239))))
- x-29215))))))
- (f-29212 x-29210)))))
- (gen-var-6599
- (lambda (id-28243)
- (let ((id-28244
- (if (if (vector? id-28243)
- (if (= (vector-length id-28243) 4)
- (eq? (vector-ref id-28243 0) 'syntax-object)
+ ((lp-35894
+ (lambda (l1-35991 l2-35992)
+ (if (null? l1-35991)
+ x-35869
+ (if (eq? (car l1-35991) (car l2-35992))
+ (lp-35894 (cdr l1-35991) (cdr l2-35992))
+ (list->vector new-35893))))))
+ (lp-35894 old-35892 new-35893))))
+ x-35869))))))
+ (f-35866 x-35864)))))
+ (gen-var-4600
+ (lambda (id-34758)
+ (let ((id-34759
+ (if (if (vector? id-34758)
+ (if (= (vector-length id-34758) 4)
+ (eq? (vector-ref id-34758 0) 'syntax-object)
#f)
#f)
- (vector-ref id-28243 1)
- id-28243)))
+ (vector-ref id-34758 1)
+ id-34758)))
(gensym
- (string-append (symbol->string id-28244) "-"))))))
+ (string-append (symbol->string id-34759) "-")))))
+ (lambda-var-list-4601
+ (lambda (vars-35993)
+ (letrec*
+ ((lvl-35994
+ (lambda (vars-35997 ls-35998 w-35999)
+ (if (pair? vars-35997)
+ (lvl-35994
+ (cdr vars-35997)
+ (cons (let ((x-36003 (car vars-35997)))
+ (if (if (null? (car w-35999))
+ (null? (cdr w-35999))
+ #f)
+ x-36003
+ (if (if (vector? x-36003)
+ (if (= (vector-length x-36003) 4)
+ (eq? (vector-ref x-36003 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-36021 (vector-ref x-36003 1))
+ (wrap-36022
+ (let ((w2-36030
+ (vector-ref x-36003 2)))
+ (let ((m1-36031 (car w-35999))
+ (s1-36032 (cdr w-35999)))
+ (if (null? m1-36031)
+ (if (null? s1-36032)
+ w2-36030
+ (cons (car w2-36030)
+ (let ((m2-36047
+ (cdr w2-36030)))
+ (if (null? m2-36047)
+ s1-36032
+ (append
+ s1-36032
+ m2-36047)))))
+ (cons (let ((m2-36055
+ (car w2-36030)))
+ (if (null? m2-36055)
+ m1-36031
+ (append
+ m1-36031
+ m2-36055)))
+ (let ((m2-36063
+ (cdr w2-36030)))
+ (if (null? m2-36063)
+ s1-36032
+ (append
+ s1-36032
+ m2-36063))))))))
+ (module-36023 (vector-ref x-36003 3)))
+ (vector
+ 'syntax-object
+ expression-36021
+ wrap-36022
+ module-36023))
+ (if (null? x-36003)
+ x-36003
+ (vector
+ 'syntax-object
+ x-36003
+ w-35999
+ #f)))))
+ ls-35998)
+ w-35999)
+ (if (if (symbol? vars-35997)
+ #t
+ (if (if (vector? vars-35997)
+ (if (= (vector-length vars-35997) 4)
+ (eq? (vector-ref vars-35997 0) 'syntax-object)
+ #f)
+ #f)
+ (symbol? (vector-ref vars-35997 1))
+ #f))
+ (cons (if (if (null? (car w-35999))
+ (null? (cdr w-35999))
+ #f)
+ vars-35997
+ (if (if (vector? vars-35997)
+ (if (= (vector-length vars-35997) 4)
+ (eq? (vector-ref vars-35997 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-36133
+ (vector-ref vars-35997 1))
+ (wrap-36134
+ (let ((w2-36144
+ (vector-ref vars-35997 2)))
+ (let ((m1-36145 (car w-35999))
+ (s1-36146 (cdr w-35999)))
+ (if (null? m1-36145)
+ (if (null? s1-36146)
+ w2-36144
+ (cons (car w2-36144)
+ (let ((m2-36163
+ (cdr w2-36144)))
+ (if (null? m2-36163)
+ s1-36146
+ (append
+ s1-36146
+ m2-36163)))))
+ (cons (let ((m2-36171
+ (car w2-36144)))
+ (if (null? m2-36171)
+ m1-36145
+ (append
+ m1-36145
+ m2-36171)))
+ (let ((m2-36179
+ (cdr w2-36144)))
+ (if (null? m2-36179)
+ s1-36146
+ (append
+ s1-36146
+ m2-36179))))))))
+ (module-36135 (vector-ref vars-35997 3)))
+ (vector
+ 'syntax-object
+ expression-36133
+ wrap-36134
+ module-36135))
+ (if (null? vars-35997)
+ vars-35997
+ (vector
+ 'syntax-object
+ vars-35997
+ w-35999
+ #f))))
+ ls-35998)
+ (if (null? vars-35997)
+ ls-35998
+ (if (if (vector? vars-35997)
+ (if (= (vector-length vars-35997) 4)
+ (eq? (vector-ref vars-35997 0) 'syntax-object)
+ #f)
+ #f)
+ (lvl-35994
+ (vector-ref vars-35997 1)
+ ls-35998
+ (let ((w2-36220 (vector-ref vars-35997 2)))
+ (let ((m1-36221 (car w-35999))
+ (s1-36222 (cdr w-35999)))
+ (if (null? m1-36221)
+ (if (null? s1-36222)
+ w2-36220
+ (cons (car w2-36220)
+ (let ((m2-36233 (cdr w2-36220)))
+ (if (null? m2-36233)
+ s1-36222
+ (append s1-36222 m2-36233)))))
+ (cons (let ((m2-36241 (car w2-36220)))
+ (if (null? m2-36241)
+ m1-36221
+ (append m1-36221 m2-36241)))
+ (let ((m2-36249 (cdr w2-36220)))
+ (if (null? m2-36249)
+ s1-36222
+ (append s1-36222 m2-36249))))))))
+ (cons vars-35997 ls-35998))))))))
+ (lvl-35994 vars-35993 '() '(()))))))
(begin
- (set! session-id-6510
- (let ((v-17707
+ (set! session-id-4511
+ (let ((v-18812
(module-variable
(current-module)
'syntax-session-id)))
- (lambda () ((variable-ref v-17707)))))
- (set! transformer-environment-6571
+ (lambda () ((variable-ref v-18812)))))
+ (set! transformer-environment-4572
(make-fluid
- (lambda (k-16750)
+ (lambda (k-17456)
(error "called outside the dynamic extent of a syntax transformer"))))
(module-define!
(current-module)
@@ -8177,1683 +9324,2389 @@
'let-syntax
'local-syntax
#f))
- (global-extend-6547
+ (global-extend-4548
'core
'syntax-parameterize
- (lambda (e-6720 r-6721 w-6722 s-6723 mod-6724)
- (let ((tmp-6726
+ (lambda (e-4728 r-4729 w-4730 s-4731 mod-4732)
+ (let ((tmp-4734
($sc-dispatch
- e-6720
+ e-4728
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-6726
+ (if (if tmp-4734
(@apply
- (lambda (var-6730 val-6731 e1-6732 e2-6733)
- (valid-bound-ids?-6575 var-6730))
- tmp-6726)
+ (lambda (var-4738 val-4739 e1-4740 e2-4741)
+ (valid-bound-ids?-4576 var-4738))
+ tmp-4734)
#f)
(@apply
- (lambda (var-6811 val-6812 e1-6813 e2-6814)
- (let ((names-6815
- (map (lambda (x-6865)
- (id-var-name-6568 x-6865 w-6722))
- var-6811)))
- (begin
- (for-each
- (lambda (id-6816 n-6817)
- (let ((atom-key-6818
- (car (let ((t-6825 (assq n-6817 r-6721)))
- (if t-6825
- (cdr t-6825)
- (if (symbol? n-6817)
- (let ((t-6830
- (get-global-definition-hook-6512
- n-6817
- mod-6724)))
- (if t-6830 t-6830 '(global)))
- '(displaced-lexical)))))))
- (if (eqv? atom-key-6818 'displaced-lexical)
- (syntax-violation
- 'syntax-parameterize
- "identifier out of context"
- e-6720
- (wrap-6578
- (begin
- (if (if (pair? id-6816) s-6723 #f)
- (set-source-properties! id-6816 s-6723))
- id-6816)
- w-6722
- mod-6724)))))
- var-6811
- names-6815)
- (expand-body-6589
- (cons e1-6813 e2-6814)
- (wrap-6578
- (begin
- (if (if (pair? e-6720) s-6723 #f)
- (set-source-properties! e-6720 s-6723))
- e-6720)
- w-6722
- mod-6724)
- (extend-env-6543
- names-6815
- (let ((trans-r-6951 (macros-only-env-6545 r-6721)))
- (map (lambda (x-6952)
+ (lambda (var-4826 val-4827 e1-4828 e2-4829)
+ (let ((names-4830
+ (map (lambda (x-5170)
+ (call-with-values
+ (lambda ()
+ (resolve-identifier-4571
+ x-5170
+ w-4730
+ r-4729
+ mod-4732
+ #f))
+ (lambda (type-5173 value-5174 mod-5175)
+ (if (eqv? type-5173 'displaced-lexical)
+ (syntax-violation
+ 'syntax-parameterize
+ "identifier out of context"
+ e-4728
+ (let ((x-5188
+ (begin
+ (if (if (pair? x-5170)
+ s-4731
+ #f)
+ (set-source-properties!
+ x-5170
+ s-4731))
+ x-5170)))
+ (if (if (null? (car w-4730))
+ (null? (cdr w-4730))
+ #f)
+ x-5188
+ (if (if (vector? x-5188)
+ (if (= (vector-length
+ x-5188)
+ 4)
+ (eq? (vector-ref x-5188 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-5220
+ (vector-ref x-5188 1))
+ (wrap-5221
+ (let ((w2-5229
+ (vector-ref
+ x-5188
+ 2)))
+ (let ((m1-5230
+ (car w-4730))
+ (s1-5231
+ (cdr w-4730)))
+ (if (null? m1-5230)
+ (if (null? s1-5231)
+ w2-5229
+ (cons (car w2-5229)
+ (let ((m2-5246
+ (cdr w2-5229)))
+ (if (null? m2-5246)
+ s1-5231
+ (append
+ s1-5231
+ m2-5246)))))
+ (cons (let ((m2-5254
+ (car w2-5229)))
+ (if (null? m2-5254)
+ m1-5230
+ (append
+ m1-5230
+ m2-5254)))
+ (let ((m2-5262
+ (cdr w2-5229)))
+ (if (null? m2-5262)
+ s1-5231
+ (append
+ s1-5231
+ m2-5262))))))))
+ (module-5222
+ (vector-ref x-5188 3)))
+ (vector
+ 'syntax-object
+ expression-5220
+ wrap-5221
+ module-5222))
+ (if (null? x-5188)
+ x-5188
+ (vector
+ 'syntax-object
+ x-5188
+ w-4730
+ mod-5175))))))
+ (if (eqv? type-5173 'syntax-parameter)
+ value-5174
+ (syntax-violation
+ 'syntax-parameterize
+ "invalid syntax parameter"
+ e-4728
+ (let ((x-5289
+ (begin
+ (if (if (pair? x-5170)
+ s-4731
+ #f)
+ (set-source-properties!
+ x-5170
+ s-4731))
+ x-5170)))
+ (if (if (null? (car w-4730))
+ (null? (cdr w-4730))
+ #f)
+ x-5289
+ (if (if (vector? x-5289)
+ (if (= (vector-length
+ x-5289)
+ 4)
+ (eq? (vector-ref
+ x-5289
+ 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-5321
+ (vector-ref x-5289 1))
+ (wrap-5322
+ (let ((w2-5330
+ (vector-ref
+ x-5289
+ 2)))
+ (let ((m1-5331
+ (car w-4730))
+ (s1-5332
+ (cdr w-4730)))
+ (if (null? m1-5331)
+ (if (null? s1-5332)
+ w2-5330
+ (cons (car w2-5330)
+ (let ((m2-5347
+ (cdr w2-5330)))
+ (if (null? m2-5347)
+ s1-5332
+ (append
+ s1-5332
+ m2-5347)))))
+ (cons (let ((m2-5355
+ (car w2-5330)))
+ (if (null? m2-5355)
+ m1-5331
+ (append
+ m1-5331
+ m2-5355)))
+ (let ((m2-5363
+ (cdr w2-5330)))
+ (if (null? m2-5363)
+ s1-5332
+ (append
+ s1-5332
+ m2-5363))))))))
+ (module-5323
+ (vector-ref
+ x-5289
+ 3)))
+ (vector
+ 'syntax-object
+ expression-5321
+ wrap-5322
+ module-5323))
+ (if (null? x-5289)
+ x-5289
+ (vector
+ 'syntax-object
+ x-5289
+ w-4730
+ mod-5175)))))))))))
+ var-4826))
+ (bindings-4831
+ (let ((trans-r-5378 (macros-only-env-4547 r-4729)))
+ (map (lambda (x-5379)
(cons 'macro
- (eval-local-transformer-6591
- (expand-6585
- x-6952
- trans-r-6951
- w-6722
- mod-6724)
- mod-6724)))
- val-6812))
- r-6721)
- w-6722
- mod-6724))))
- tmp-6726)
+ (eval-local-transformer-4592
+ (expand-4586
+ x-5379
+ trans-r-5378
+ w-4730
+ mod-4732)
+ mod-4732)))
+ val-4827))))
+ (expand-body-4590
+ (cons e1-4828 e2-4829)
+ (let ((x-4843
+ (begin
+ (if (if (pair? e-4728) s-4731 #f)
+ (set-source-properties! e-4728 s-4731))
+ e-4728)))
+ (if (if (null? (car w-4730)) (null? (cdr w-4730)) #f)
+ x-4843
+ (if (if (vector? x-4843)
+ (if (= (vector-length x-4843) 4)
+ (eq? (vector-ref x-4843 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-4875 (vector-ref x-4843 1))
+ (wrap-4876
+ (let ((w2-4884 (vector-ref x-4843 2)))
+ (let ((m1-4885 (car w-4730))
+ (s1-4886 (cdr w-4730)))
+ (if (null? m1-4885)
+ (if (null? s1-4886)
+ w2-4884
+ (cons (car w2-4884)
+ (let ((m2-4901
+ (cdr w2-4884)))
+ (if (null? m2-4901)
+ s1-4886
+ (append
+ s1-4886
+ m2-4901)))))
+ (cons (let ((m2-4909 (car w2-4884)))
+ (if (null? m2-4909)
+ m1-4885
+ (append m1-4885 m2-4909)))
+ (let ((m2-4917 (cdr w2-4884)))
+ (if (null? m2-4917)
+ s1-4886
+ (append
+ s1-4886
+ m2-4917))))))))
+ (module-4877 (vector-ref x-4843 3)))
+ (vector
+ 'syntax-object
+ expression-4875
+ wrap-4876
+ module-4877))
+ (if (null? x-4843)
+ x-4843
+ (vector
+ 'syntax-object
+ x-4843
+ w-4730
+ mod-4732)))))
+ (extend-env-4545 names-4830 bindings-4831 r-4729)
+ w-4730
+ mod-4732)))
+ tmp-4734)
(syntax-violation
'syntax-parameterize
"bad syntax"
- (wrap-6578
- (begin
- (if (if (pair? e-6720) s-6723 #f)
- (set-source-properties! e-6720 s-6723))
- e-6720)
- w-6722
- mod-6724))))))
+ (let ((x-5599
+ (begin
+ (if (if (pair? e-4728) s-4731 #f)
+ (set-source-properties! e-4728 s-4731))
+ e-4728)))
+ (if (if (null? (car w-4730)) (null? (cdr w-4730)) #f)
+ x-5599
+ (if (if (vector? x-5599)
+ (if (= (vector-length x-5599) 4)
+ (eq? (vector-ref x-5599 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-5631 (vector-ref x-5599 1))
+ (wrap-5632
+ (let ((w2-5640 (vector-ref x-5599 2)))
+ (let ((m1-5641 (car w-4730))
+ (s1-5642 (cdr w-4730)))
+ (if (null? m1-5641)
+ (if (null? s1-5642)
+ w2-5640
+ (cons (car w2-5640)
+ (let ((m2-5657 (cdr w2-5640)))
+ (if (null? m2-5657)
+ s1-5642
+ (append s1-5642 m2-5657)))))
+ (cons (let ((m2-5665 (car w2-5640)))
+ (if (null? m2-5665)
+ m1-5641
+ (append m1-5641 m2-5665)))
+ (let ((m2-5673 (cdr w2-5640)))
+ (if (null? m2-5673)
+ s1-5642
+ (append s1-5642 m2-5673))))))))
+ (module-5633 (vector-ref x-5599 3)))
+ (vector
+ 'syntax-object
+ expression-5631
+ wrap-5632
+ module-5633))
+ (if (null? x-5599)
+ x-5599
+ (vector 'syntax-object x-5599 w-4730 mod-4732))))))))))
(module-define!
(current-module)
'quote
(make-syntax-transformer
'quote
'core
- (lambda (e-7161 r-7162 w-7163 s-7164 mod-7165)
- (let ((tmp-7167 ($sc-dispatch e-7161 '(_ any))))
- (if tmp-7167
+ (lambda (e-5701 r-5702 w-5703 s-5704 mod-5705)
+ (let ((tmp-5707 ($sc-dispatch e-5701 '(_ any))))
+ (if tmp-5707
(@apply
- (lambda (e-7170)
- (let ((exp-7174 (strip-6598 e-7170 w-7163)))
+ (lambda (e-5710)
+ (let ((exp-5714 (strip-4599 e-5710 w-5703)))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
- s-7164
- exp-7174)))
- tmp-7167)
+ s-5704
+ exp-5714)))
+ tmp-5707)
(syntax-violation
'quote
"bad syntax"
- (wrap-6578
- (begin
- (if (if (pair? e-7161) s-7164 #f)
- (set-source-properties! e-7161 s-7164))
- e-7161)
- w-7163
- mod-7165)))))))
- (global-extend-6547
+ (let ((x-5728
+ (begin
+ (if (if (pair? e-5701) s-5704 #f)
+ (set-source-properties! e-5701 s-5704))
+ e-5701)))
+ (if (if (null? (car w-5703)) (null? (cdr w-5703)) #f)
+ x-5728
+ (if (if (vector? x-5728)
+ (if (= (vector-length x-5728) 4)
+ (eq? (vector-ref x-5728 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-5760 (vector-ref x-5728 1))
+ (wrap-5761
+ (let ((w2-5769 (vector-ref x-5728 2)))
+ (let ((m1-5770 (car w-5703))
+ (s1-5771 (cdr w-5703)))
+ (if (null? m1-5770)
+ (if (null? s1-5771)
+ w2-5769
+ (cons (car w2-5769)
+ (let ((m2-5786 (cdr w2-5769)))
+ (if (null? m2-5786)
+ s1-5771
+ (append s1-5771 m2-5786)))))
+ (cons (let ((m2-5794 (car w2-5769)))
+ (if (null? m2-5794)
+ m1-5770
+ (append m1-5770 m2-5794)))
+ (let ((m2-5802 (cdr w2-5769)))
+ (if (null? m2-5802)
+ s1-5771
+ (append s1-5771 m2-5802))))))))
+ (module-5762 (vector-ref x-5728 3)))
+ (vector
+ 'syntax-object
+ expression-5760
+ wrap-5761
+ module-5762))
+ (if (null? x-5728)
+ x-5728
+ (vector
+ 'syntax-object
+ x-5728
+ w-5703
+ mod-5705)))))))))))
+ (global-extend-4548
'core
'syntax
(letrec*
- ((gen-syntax-7394
- (lambda (src-7496
- e-7497
- r-7498
- maps-7499
- ellipsis?-7500
- mod-7501)
- (if (if (symbol? e-7497)
+ ((gen-syntax-6020
+ (lambda (src-6451
+ e-6452
+ r-6453
+ maps-6454
+ ellipsis?-6455
+ mod-6456)
+ (if (if (symbol? e-6452)
#t
- (if (if (vector? e-7497)
- (if (= (vector-length e-7497) 4)
- (eq? (vector-ref e-7497 0) 'syntax-object)
+ (if (if (vector? e-6452)
+ (if (= (vector-length e-6452) 4)
+ (eq? (vector-ref e-6452 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-7497 1))
+ (symbol? (vector-ref e-6452 1))
+ #f))
+ (call-with-values
+ (lambda ()
+ (resolve-identifier-4571
+ e-6452
+ '(())
+ r-6453
+ mod-6456
#f))
- (let ((label-7528 (id-var-name-6568 e-7497 '(()))))
- (let ((b-7529
- (let ((t-7536 (assq label-7528 r-7498)))
- (if t-7536
- (cdr t-7536)
- (if (symbol? label-7528)
- (let ((t-7542
- (get-global-definition-hook-6512
- label-7528
- mod-7501)))
- (if t-7542 t-7542 '(global)))
- '(displaced-lexical))))))
- (if (eq? (car b-7529) 'syntax)
+ (lambda (type-6485 value-6486 mod-6487)
+ (if (eqv? type-6485 'syntax)
(call-with-values
(lambda ()
- (let ((var.lev-7551 (cdr b-7529)))
- (gen-ref-7395
- src-7496
- (car var.lev-7551)
- (cdr var.lev-7551)
- maps-7499)))
- (lambda (var-7555 maps-7556)
- (values (list 'ref var-7555) maps-7556)))
- (if (ellipsis?-7500 e-7497)
+ (gen-ref-6021
+ src-6451
+ (car value-6486)
+ (cdr value-6486)
+ maps-6454))
+ (lambda (var-6493 maps-6494)
+ (values (list 'ref var-6493) maps-6494)))
+ (if (ellipsis?-6455 e-6452)
(syntax-violation
'syntax
"misplaced ellipsis"
- src-7496)
- (values (list 'quote e-7497) maps-7499)))))
- (let ((tmp-7558 ($sc-dispatch e-7497 '(any any))))
- (if (if tmp-7558
+ src-6451)
+ (values (list 'quote e-6452) maps-6454)))))
+ (let ((tmp-6496 ($sc-dispatch e-6452 '(any any))))
+ (if (if tmp-6496
(@apply
- (lambda (dots-7562 e-7563)
- (ellipsis?-7500 dots-7562))
- tmp-7558)
+ (lambda (dots-6500 e-6501)
+ (ellipsis?-6455 dots-6500))
+ tmp-6496)
#f)
(@apply
- (lambda (dots-7564 e-7565)
- (gen-syntax-7394
- src-7496
- e-7565
- r-7498
- maps-7499
- (lambda (x-7566) #f)
- mod-7501))
- tmp-7558)
- (let ((tmp-7567 ($sc-dispatch e-7497 '(any any . any))))
- (if (if tmp-7567
+ (lambda (dots-6502 e-6503)
+ (gen-syntax-6020
+ src-6451
+ e-6503
+ r-6453
+ maps-6454
+ (lambda (x-6504) #f)
+ mod-6456))
+ tmp-6496)
+ (let ((tmp-6505 ($sc-dispatch e-6452 '(any any . any))))
+ (if (if tmp-6505
(@apply
- (lambda (x-7571 dots-7572 y-7573)
- (ellipsis?-7500 dots-7572))
- tmp-7567)
+ (lambda (x-6509 dots-6510 y-6511)
+ (ellipsis?-6455 dots-6510))
+ tmp-6505)
#f)
(@apply
- (lambda (x-7574 dots-7575 y-7576)
+ (lambda (x-6512 dots-6513 y-6514)
(letrec*
- ((f-7577
- (lambda (y-7585 k-7586)
- (let ((tmp-7588
+ ((f-6515
+ (lambda (y-6523 k-6524)
+ (let ((tmp-6526
($sc-dispatch
- y-7585
+ y-6523
'(any . any))))
- (if (if tmp-7588
+ (if (if tmp-6526
(@apply
- (lambda (dots-7592 y-7593)
- (ellipsis?-7500 dots-7592))
- tmp-7588)
+ (lambda (dots-6530 y-6531)
+ (ellipsis?-6455 dots-6530))
+ tmp-6526)
#f)
(@apply
- (lambda (dots-7594 y-7595)
- (f-7577
- y-7595
- (lambda (maps-7596)
+ (lambda (dots-6532 y-6533)
+ (f-6515
+ y-6533
+ (lambda (maps-6534)
(call-with-values
(lambda ()
- (k-7586
- (cons '() maps-7596)))
- (lambda (x-7597 maps-7598)
- (if (null? (car maps-7598))
+ (k-6524
+ (cons '() maps-6534)))
+ (lambda (x-6535 maps-6536)
+ (if (null? (car maps-6536))
(syntax-violation
'syntax
"extra ellipsis"
- src-7496)
+ src-6451)
(values
- (let ((map-env-7602
- (car maps-7598)))
+ (let ((map-env-6540
+ (car maps-6536)))
(list 'apply
'(primitive
append)
- (gen-map-7397
- x-7597
- map-env-7602)))
- (cdr maps-7598))))))))
- tmp-7588)
+ (gen-map-6023
+ x-6535
+ map-env-6540)))
+ (cdr maps-6536))))))))
+ tmp-6526)
(call-with-values
(lambda ()
- (gen-syntax-7394
- src-7496
- y-7585
- r-7498
- maps-7499
- ellipsis?-7500
- mod-7501))
- (lambda (y-7605 maps-7606)
+ (gen-syntax-6020
+ src-6451
+ y-6523
+ r-6453
+ maps-6454
+ ellipsis?-6455
+ mod-6456))
+ (lambda (y-6543 maps-6544)
(call-with-values
- (lambda () (k-7586 maps-7606))
- (lambda (x-7607 maps-7608)
+ (lambda () (k-6524 maps-6544))
+ (lambda (x-6545 maps-6546)
(values
- (if (equal? y-7605 ''())
- x-7607
+ (if (equal? y-6543 ''())
+ x-6545
(list 'append
- x-7607
- y-7605))
- maps-7608))))))))))
- (f-7577
- y-7576
- (lambda (maps-7580)
+ x-6545
+ y-6543))
+ maps-6546))))))))))
+ (f-6515
+ y-6514
+ (lambda (maps-6518)
(call-with-values
(lambda ()
- (gen-syntax-7394
- src-7496
- x-7574
- r-7498
- (cons '() maps-7580)
- ellipsis?-7500
- mod-7501))
- (lambda (x-7581 maps-7582)
- (if (null? (car maps-7582))
+ (gen-syntax-6020
+ src-6451
+ x-6512
+ r-6453
+ (cons '() maps-6518)
+ ellipsis?-6455
+ mod-6456))
+ (lambda (x-6519 maps-6520)
+ (if (null? (car maps-6520))
(syntax-violation
'syntax
"extra ellipsis"
- src-7496)
+ src-6451)
(values
- (gen-map-7397
- x-7581
- (car maps-7582))
- (cdr maps-7582)))))))))
- tmp-7567)
- (let ((tmp-7624 ($sc-dispatch e-7497 '(any . any))))
- (if tmp-7624
+ (gen-map-6023
+ x-6519
+ (car maps-6520))
+ (cdr maps-6520)))))))))
+ tmp-6505)
+ (let ((tmp-6562 ($sc-dispatch e-6452 '(any . any))))
+ (if tmp-6562
(@apply
- (lambda (x-7628 y-7629)
+ (lambda (x-6566 y-6567)
(call-with-values
(lambda ()
- (gen-syntax-7394
- src-7496
- x-7628
- r-7498
- maps-7499
- ellipsis?-7500
- mod-7501))
- (lambda (x-7630 maps-7631)
+ (gen-syntax-6020
+ src-6451
+ x-6566
+ r-6453
+ maps-6454
+ ellipsis?-6455
+ mod-6456))
+ (lambda (x-6568 maps-6569)
(call-with-values
(lambda ()
- (gen-syntax-7394
- src-7496
- y-7629
- r-7498
- maps-7631
- ellipsis?-7500
- mod-7501))
- (lambda (y-7632 maps-7633)
+ (gen-syntax-6020
+ src-6451
+ y-6567
+ r-6453
+ maps-6569
+ ellipsis?-6455
+ mod-6456))
+ (lambda (y-6570 maps-6571)
(values
- (let ((atom-key-7638 (car y-7632)))
- (if (eqv? atom-key-7638 'quote)
- (if (eq? (car x-7630) 'quote)
+ (let ((atom-key-6576 (car y-6570)))
+ (if (eqv? atom-key-6576 'quote)
+ (if (eq? (car x-6568) 'quote)
(list 'quote
- (cons (car (cdr x-7630))
- (car (cdr y-7632))))
- (if (eq? (car (cdr y-7632))
+ (cons (car (cdr x-6568))
+ (car (cdr y-6570))))
+ (if (eq? (car (cdr y-6570))
'())
- (list 'list x-7630)
- (list 'cons x-7630 y-7632)))
- (if (eqv? atom-key-7638 'list)
+ (list 'list x-6568)
+ (list 'cons x-6568 y-6570)))
+ (if (eqv? atom-key-6576 'list)
(cons 'list
- (cons x-7630
- (cdr y-7632)))
- (list 'cons x-7630 y-7632))))
- maps-7633))))))
- tmp-7624)
- (let ((tmp-7667
+ (cons x-6568
+ (cdr y-6570)))
+ (list 'cons x-6568 y-6570))))
+ maps-6571))))))
+ tmp-6562)
+ (let ((tmp-6605
($sc-dispatch
- e-7497
+ e-6452
'#(vector (any . each-any)))))
- (if tmp-7667
+ (if tmp-6605
(@apply
- (lambda (e1-7671 e2-7672)
+ (lambda (e1-6609 e2-6610)
(call-with-values
(lambda ()
- (gen-syntax-7394
- src-7496
- (cons e1-7671 e2-7672)
- r-7498
- maps-7499
- ellipsis?-7500
- mod-7501))
- (lambda (e-7673 maps-7674)
+ (gen-syntax-6020
+ src-6451
+ (cons e1-6609 e2-6610)
+ r-6453
+ maps-6454
+ ellipsis?-6455
+ mod-6456))
+ (lambda (e-6611 maps-6612)
(values
- (if (eq? (car e-7673) 'list)
- (cons 'vector (cdr e-7673))
- (if (eq? (car e-7673) 'quote)
+ (if (eq? (car e-6611) 'list)
+ (cons 'vector (cdr e-6611))
+ (if (eq? (car e-6611) 'quote)
(list 'quote
(list->vector
- (car (cdr e-7673))))
- (list 'list->vector e-7673)))
- maps-7674))))
- tmp-7667)
+ (car (cdr e-6611))))
+ (list 'list->vector e-6611)))
+ maps-6612))))
+ tmp-6605)
(values
- (list 'quote e-7497)
- maps-7499))))))))))))
- (gen-ref-7395
- (lambda (src-7701 var-7702 level-7703 maps-7704)
- (if (= level-7703 0)
- (values var-7702 maps-7704)
- (if (null? maps-7704)
+ (list 'quote e-6452)
+ maps-6454))))))))))))
+ (gen-ref-6021
+ (lambda (src-6639 var-6640 level-6641 maps-6642)
+ (if (= level-6641 0)
+ (values var-6640 maps-6642)
+ (if (null? maps-6642)
(syntax-violation
'syntax
"missing ellipsis"
- src-7701)
+ src-6639)
(call-with-values
(lambda ()
- (gen-ref-7395
- src-7701
- var-7702
- (#{1-}# level-7703)
- (cdr maps-7704)))
- (lambda (outer-var-7705 outer-maps-7706)
- (let ((b-7707 (assq outer-var-7705 (car maps-7704))))
- (if b-7707
- (values (cdr b-7707) maps-7704)
- (let ((inner-var-7709
+ (gen-ref-6021
+ src-6639
+ var-6640
+ (#{1-}# level-6641)
+ (cdr maps-6642)))
+ (lambda (outer-var-6643 outer-maps-6644)
+ (let ((b-6645 (assq outer-var-6643 (car maps-6642))))
+ (if b-6645
+ (values (cdr b-6645) maps-6642)
+ (let ((inner-var-6647
(gensym
(string-append
(symbol->string 'tmp)
"-"))))
(values
- inner-var-7709
- (cons (cons (cons outer-var-7705 inner-var-7709)
- (car maps-7704))
- outer-maps-7706)))))))))))
- (gen-map-7397
- (lambda (e-7723 map-env-7724)
- (let ((formals-7725 (map cdr map-env-7724))
- (actuals-7726
- (map (lambda (x-7728) (list 'ref (car x-7728)))
- map-env-7724)))
- (if (eq? (car e-7723) 'ref)
- (car actuals-7726)
+ inner-var-6647
+ (cons (cons (cons outer-var-6643 inner-var-6647)
+ (car maps-6642))
+ outer-maps-6644)))))))))))
+ (gen-map-6023
+ (lambda (e-6661 map-env-6662)
+ (let ((formals-6663 (map cdr map-env-6662))
+ (actuals-6664
+ (map (lambda (x-6666) (list 'ref (car x-6666)))
+ map-env-6662)))
+ (if (eq? (car e-6661) 'ref)
+ (car actuals-6664)
(if (and-map
- (lambda (x-7729)
- (if (eq? (car x-7729) 'ref)
- (memq (car (cdr x-7729)) formals-7725)
+ (lambda (x-6667)
+ (if (eq? (car x-6667) 'ref)
+ (memq (car (cdr x-6667)) formals-6663)
#f))
- (cdr e-7723))
+ (cdr e-6661))
(cons 'map
- (cons (list 'primitive (car e-7723))
- (map (let ((r-7731
+ (cons (list 'primitive (car e-6661))
+ (map (let ((r-6669
(map cons
- formals-7725
- actuals-7726)))
- (lambda (x-7732)
- (cdr (assq (car (cdr x-7732))
- r-7731))))
- (cdr e-7723))))
+ formals-6663
+ actuals-6664)))
+ (lambda (x-6670)
+ (cdr (assq (car (cdr x-6670))
+ r-6669))))
+ (cdr e-6661))))
(cons 'map
- (cons (list 'lambda formals-7725 e-7723)
- actuals-7726)))))))
- (regen-7401
- (lambda (x-7734)
- (let ((atom-key-7735 (car x-7734)))
- (if (eqv? atom-key-7735 'ref)
- (let ((name-7745 (car (cdr x-7734)))
- (var-7746 (car (cdr x-7734))))
+ (cons (list 'lambda formals-6663 e-6661)
+ actuals-6664)))))))
+ (regen-6027
+ (lambda (x-6672)
+ (let ((atom-key-6673 (car x-6672)))
+ (if (eqv? atom-key-6673 'ref)
+ (let ((name-6683 (car (cdr x-6672)))
+ (var-6684 (car (cdr x-6672))))
(make-struct/no-tail
(vector-ref %expanded-vtables 3)
#f
- name-7745
- var-7746))
- (if (eqv? atom-key-7735 'primitive)
- (let ((name-7758 (car (cdr x-7734))))
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- name-7758)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- name-7758
- #f)))
- (if (eqv? atom-key-7735 'quote)
- (let ((exp-7776 (car (cdr x-7734))))
+ name-6683
+ var-6684))
+ (if (eqv? atom-key-6673 'primitive)
+ (let ((name-6695 (car (cdr x-6672))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 2)
+ #f
+ name-6695))
+ (if (eqv? atom-key-6673 'quote)
+ (let ((exp-6706 (car (cdr x-6672))))
(make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
- exp-7776))
- (if (eqv? atom-key-7735 'lambda)
- (if (list? (car (cdr x-7734)))
- (let ((req-7787 (car (cdr x-7734)))
- (vars-7789 (car (cdr x-7734)))
- (exp-7791
- (regen-7401 (car (cdr (cdr x-7734))))))
- (let ((body-7796
+ exp-6706))
+ (if (eqv? atom-key-6673 'lambda)
+ (if (list? (car (cdr x-6672)))
+ (let ((req-6717 (car (cdr x-6672)))
+ (vars-6719 (car (cdr x-6672)))
+ (exp-6721
+ (regen-6027 (car (cdr (cdr x-6672))))))
+ (let ((body-6726
(make-struct/no-tail
- (vector-ref %expanded-vtables 14)
+ (vector-ref %expanded-vtables 15)
#f
- req-7787
+ req-6717
#f
#f
#f
'()
- vars-7789
- exp-7791
+ vars-6719
+ exp-6721
#f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
+ (vector-ref %expanded-vtables 14)
#f
'()
- body-7796)))
- (error "how did we get here" x-7734))
- (let ((fun-exp-7812
- (let ((name-7821 (car x-7734)))
- (if (equal?
- (module-name (current-module))
- '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- name-7821)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- name-7821
- #f))))
- (arg-exps-7813 (map regen-7401 (cdr x-7734))))
+ body-6726)))
+ (error "how did we get here" x-6672))
+ (let ((name-6742 (car x-6672))
+ (args-6743 (map regen-6027 (cdr x-6672))))
(make-struct/no-tail
- (vector-ref %expanded-vtables 11)
+ (vector-ref %expanded-vtables 12)
#f
- fun-exp-7812
- arg-exps-7813))))))))))
- (lambda (e-7402 r-7403 w-7404 s-7405 mod-7406)
- (let ((e-7407
- (wrap-6578
- (begin
- (if (if (pair? e-7402) s-7405 #f)
- (set-source-properties! e-7402 s-7405))
- e-7402)
- w-7404
- mod-7406)))
- (let ((tmp-7409 ($sc-dispatch e-7407 '(_ any))))
- (if tmp-7409
- (@apply
- (lambda (x-7434)
- (call-with-values
- (lambda ()
- (gen-syntax-7394
- e-7407
- x-7434
- r-7403
- '()
- ellipsis?-6593
- mod-7406))
- (lambda (e-7488 maps-7489) (regen-7401 e-7488))))
- tmp-7409)
- (syntax-violation
- 'syntax
- "bad `syntax' form"
- e-7407)))))))
- (global-extend-6547
+ name-6742
+ args-6743))))))))))
+ (lambda (e-6028 r-6029 w-6030 s-6031 mod-6032)
+ (let ((e-6033
+ (let ((x-6362
+ (begin
+ (if (if (pair? e-6028) s-6031 #f)
+ (set-source-properties! e-6028 s-6031))
+ e-6028)))
+ (if (if (null? (car w-6030)) (null? (cdr w-6030)) #f)
+ x-6362
+ (if (if (vector? x-6362)
+ (if (= (vector-length x-6362) 4)
+ (eq? (vector-ref x-6362 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-6394 (vector-ref x-6362 1))
+ (wrap-6395
+ (let ((w2-6403 (vector-ref x-6362 2)))
+ (let ((m1-6404 (car w-6030))
+ (s1-6405 (cdr w-6030)))
+ (if (null? m1-6404)
+ (if (null? s1-6405)
+ w2-6403
+ (cons (car w2-6403)
+ (let ((m2-6420 (cdr w2-6403)))
+ (if (null? m2-6420)
+ s1-6405
+ (append
+ s1-6405
+ m2-6420)))))
+ (cons (let ((m2-6428 (car w2-6403)))
+ (if (null? m2-6428)
+ m1-6404
+ (append m1-6404 m2-6428)))
+ (let ((m2-6436 (cdr w2-6403)))
+ (if (null? m2-6436)
+ s1-6405
+ (append
+ s1-6405
+ m2-6436))))))))
+ (module-6396 (vector-ref x-6362 3)))
+ (vector
+ 'syntax-object
+ expression-6394
+ wrap-6395
+ module-6396))
+ (if (null? x-6362)
+ x-6362
+ (vector
+ 'syntax-object
+ x-6362
+ w-6030
+ mod-6032)))))))
+ (let ((tmp-6034 e-6033))
+ (let ((tmp-6035 ($sc-dispatch tmp-6034 '(_ any))))
+ (if tmp-6035
+ (@apply
+ (lambda (x-6083)
+ (call-with-values
+ (lambda ()
+ (gen-syntax-6020
+ e-6033
+ x-6083
+ r-6029
+ '()
+ ellipsis?-4594
+ mod-6032))
+ (lambda (e-6160 maps-6161) (regen-6027 e-6160))))
+ tmp-6035)
+ (syntax-violation
+ 'syntax
+ "bad `syntax' form"
+ e-6033))))))))
+ (global-extend-4548
'core
'lambda
- (lambda (e-8009 r-8010 w-8011 s-8012 mod-8013)
- (let ((tmp-8015
- ($sc-dispatch e-8009 '(_ any any . each-any))))
- (if tmp-8015
+ (lambda (e-6974 r-6975 w-6976 s-6977 mod-6978)
+ (let ((tmp-6980
+ ($sc-dispatch e-6974 '(_ any any . each-any))))
+ (if tmp-6980
(@apply
- (lambda (args-8019 e1-8020 e2-8021)
+ (lambda (args-6984 e1-6985 e2-6986)
(call-with-values
- (lambda () (lambda-formals-6594 args-8019))
- (lambda (req-8024 opt-8025 rest-8026 kw-8027)
+ (lambda () (lambda-formals-4595 args-6984))
+ (lambda (req-6989 opt-6990 rest-6991 kw-6992)
(letrec*
- ((lp-8028
- (lambda (body-8031 meta-8032)
- (let ((tmp-8034
+ ((lp-6993
+ (lambda (body-6996 meta-6997)
+ (let ((tmp-6999
($sc-dispatch
- body-8031
+ body-6996
'(any any . each-any))))
- (if (if tmp-8034
+ (if (if tmp-6999
(@apply
- (lambda (docstring-8038 e1-8039 e2-8040)
+ (lambda (docstring-7003 e1-7004 e2-7005)
(string?
- (syntax->datum docstring-8038)))
- tmp-8034)
+ (syntax->datum docstring-7003)))
+ tmp-6999)
#f)
(@apply
- (lambda (docstring-8041 e1-8042 e2-8043)
- (lp-8028
- (cons e1-8042 e2-8043)
+ (lambda (docstring-7006 e1-7007 e2-7008)
+ (lp-6993
+ (cons e1-7007 e2-7008)
(append
- meta-8032
+ meta-6997
(list (cons 'documentation
(syntax->datum
- docstring-8041))))))
- tmp-8034)
- (let ((tmp-8044
+ docstring-7006))))))
+ tmp-6999)
+ (let ((tmp-7009
($sc-dispatch
- body-8031
+ body-6996
'(#(vector #(each (any . any)))
any
.
each-any))))
- (if tmp-8044
+ (if tmp-7009
(@apply
- (lambda (k-8048 v-8049 e1-8050 e2-8051)
- (lp-8028
- (cons e1-8050 e2-8051)
+ (lambda (k-7013 v-7014 e1-7015 e2-7016)
+ (lp-6993
+ (cons e1-7015 e2-7016)
(append
- meta-8032
+ meta-6997
(syntax->datum
- (map cons k-8048 v-8049)))))
- tmp-8044)
- (expand-simple-lambda-6595
- e-8009
- r-8010
- w-8011
- s-8012
- mod-8013
- req-8024
- rest-8026
- meta-8032
- body-8031))))))))
- (lp-8028 (cons e1-8020 e2-8021) '())))))
- tmp-8015)
- (syntax-violation 'lambda "bad lambda" e-8009)))))
- (global-extend-6547
+ (map cons k-7013 v-7014)))))
+ tmp-7009)
+ (expand-simple-lambda-4596
+ e-6974
+ r-6975
+ w-6976
+ s-6977
+ mod-6978
+ req-6989
+ rest-6991
+ meta-6997
+ body-6996))))))))
+ (lp-6993 (cons e1-6985 e2-6986) '())))))
+ tmp-6980)
+ (syntax-violation 'lambda "bad lambda" e-6974)))))
+ (global-extend-4548
'core
'lambda*
- (lambda (e-8340 r-8341 w-8342 s-8343 mod-8344)
- (let ((tmp-8346
- ($sc-dispatch e-8340 '(_ any any . each-any))))
- (if tmp-8346
+ (lambda (e-7391 r-7392 w-7393 s-7394 mod-7395)
+ (let ((tmp-7397
+ ($sc-dispatch e-7391 '(_ any any . each-any))))
+ (if tmp-7397
(@apply
- (lambda (args-8350 e1-8351 e2-8352)
+ (lambda (args-7401 e1-7402 e2-7403)
(call-with-values
(lambda ()
- (expand-lambda-case-6597
- e-8340
- r-8341
- w-8342
- s-8343
- mod-8344
- lambda*-formals-6596
- (list (cons args-8350 (cons e1-8351 e2-8352)))))
- (lambda (meta-8355 lcase-8356)
+ (expand-lambda-case-4598
+ e-7391
+ r-7392
+ w-7393
+ s-7394
+ mod-7395
+ lambda*-formals-4597
+ (list (cons args-7401 (cons e1-7402 e2-7403)))))
+ (lambda (meta-7406 lcase-7407)
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-8343
- meta-8355
- lcase-8356))))
- tmp-8346)
- (syntax-violation 'lambda "bad lambda*" e-8340)))))
- (global-extend-6547
+ (vector-ref %expanded-vtables 14)
+ s-7394
+ meta-7406
+ lcase-7407))))
+ tmp-7397)
+ (syntax-violation 'lambda "bad lambda*" e-7391)))))
+ (global-extend-4548
'core
'case-lambda
- (lambda (e-8526 r-8527 w-8528 s-8529 mod-8530)
- (let ((tmp-8532
+ (lambda (e-7570 r-7571 w-7572 s-7573 mod-7574)
+ (let ((tmp-7576
($sc-dispatch
- e-8526
+ e-7570
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-8532
+ (if tmp-7576
(@apply
- (lambda (args-8536
- e1-8537
- e2-8538
- args*-8539
- e1*-8540
- e2*-8541)
+ (lambda (args-7580
+ e1-7581
+ e2-7582
+ args*-7583
+ e1*-7584
+ e2*-7585)
(call-with-values
(lambda ()
- (expand-lambda-case-6597
- e-8526
- r-8527
- w-8528
- s-8529
- mod-8530
- lambda-formals-6594
- (cons (cons args-8536 (cons e1-8537 e2-8538))
- (map (lambda (tmp-5448-8544
- tmp-5447-8545
- tmp-5446-8546)
- (cons tmp-5446-8546
- (cons tmp-5447-8545 tmp-5448-8544)))
- e2*-8541
- e1*-8540
- args*-8539))))
- (lambda (meta-8547 lcase-8548)
+ (expand-lambda-case-4598
+ e-7570
+ r-7571
+ w-7572
+ s-7573
+ mod-7574
+ lambda-formals-4595
+ (cons (cons args-7580 (cons e1-7581 e2-7582))
+ (map (lambda (tmp-3460-7588
+ tmp-3459-7589
+ tmp-3458-7590)
+ (cons tmp-3458-7590
+ (cons tmp-3459-7589 tmp-3460-7588)))
+ e2*-7585
+ e1*-7584
+ args*-7583))))
+ (lambda (meta-7591 lcase-7592)
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-8529
- meta-8547
- lcase-8548))))
- tmp-8532)
+ (vector-ref %expanded-vtables 14)
+ s-7573
+ meta-7591
+ lcase-7592))))
+ tmp-7576)
(syntax-violation
'case-lambda
"bad case-lambda"
- e-8526)))))
- (global-extend-6547
+ e-7570)))))
+ (global-extend-4548
'core
'case-lambda*
- (lambda (e-8710 r-8711 w-8712 s-8713 mod-8714)
- (let ((tmp-8716
+ (lambda (e-7761 r-7762 w-7763 s-7764 mod-7765)
+ (let ((tmp-7767
($sc-dispatch
- e-8710
+ e-7761
'(_ (any any . each-any)
.
#(each (any any . each-any))))))
- (if tmp-8716
+ (if tmp-7767
(@apply
- (lambda (args-8720
- e1-8721
- e2-8722
- args*-8723
- e1*-8724
- e2*-8725)
+ (lambda (args-7771
+ e1-7772
+ e2-7773
+ args*-7774
+ e1*-7775
+ e2*-7776)
(call-with-values
(lambda ()
- (expand-lambda-case-6597
- e-8710
- r-8711
- w-8712
- s-8713
- mod-8714
- lambda*-formals-6596
- (cons (cons args-8720 (cons e1-8721 e2-8722))
- (map (lambda (tmp-5483-8728
- tmp-5482-8729
- tmp-5481-8730)
- (cons tmp-5481-8730
- (cons tmp-5482-8729 tmp-5483-8728)))
- e2*-8725
- e1*-8724
- args*-8723))))
- (lambda (meta-8731 lcase-8732)
+ (expand-lambda-case-4598
+ e-7761
+ r-7762
+ w-7763
+ s-7764
+ mod-7765
+ lambda*-formals-4597
+ (cons (cons args-7771 (cons e1-7772 e2-7773))
+ (map (lambda (tmp-3495-7779
+ tmp-3494-7780
+ tmp-3493-7781)
+ (cons tmp-3493-7781
+ (cons tmp-3494-7780 tmp-3495-7779)))
+ e2*-7776
+ e1*-7775
+ args*-7774))))
+ (lambda (meta-7782 lcase-7783)
(make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- s-8713
- meta-8731
- lcase-8732))))
- tmp-8716)
+ (vector-ref %expanded-vtables 14)
+ s-7764
+ meta-7782
+ lcase-7783))))
+ tmp-7767)
(syntax-violation
'case-lambda
"bad case-lambda*"
- e-8710)))))
- (global-extend-6547
+ e-7761)))))
+ (global-extend-4548
'core
'let
(letrec*
- ((expand-let-8923
- (lambda (e-9072
- r-9073
- w-9074
- s-9075
- mod-9076
- constructor-9077
- ids-9078
- vals-9079
- exps-9080)
- (if (not (valid-bound-ids?-6575 ids-9078))
+ ((expand-let-7991
+ (lambda (e-8201
+ r-8202
+ w-8203
+ s-8204
+ mod-8205
+ constructor-8206
+ ids-8207
+ vals-8208
+ exps-8209)
+ (if (not (valid-bound-ids?-4576 ids-8207))
(syntax-violation
'let
"duplicate bound variable"
- e-9072)
- (let ((labels-9158 (gen-labels-6552 ids-9078))
- (new-vars-9159 (map gen-var-6599 ids-9078)))
- (let ((nw-9160
- (make-binding-wrap-6563
- ids-9078
- labels-9158
- w-9074))
- (nr-9161
- (extend-var-env-6544
- labels-9158
- new-vars-9159
- r-9073)))
- (constructor-9077
- s-9075
- (map syntax->datum ids-9078)
- new-vars-9159
- (map (lambda (x-9178)
- (expand-6585 x-9178 r-9073 w-9074 mod-9076))
- vals-9079)
- (expand-body-6589
- exps-9080
- (source-wrap-6579 e-9072 nw-9160 s-9075 mod-9076)
- nr-9161
- nw-9160
- mod-9076))))))))
- (lambda (e-8924 r-8925 w-8926 s-8927 mod-8928)
- (let ((tmp-8930
+ e-8201)
+ (let ((labels-8294 (gen-labels-4553 ids-8207))
+ (new-vars-8295 (map gen-var-4600 ids-8207)))
+ (let ((nw-8296
+ (make-binding-wrap-4564
+ ids-8207
+ labels-8294
+ w-8203))
+ (nr-8297
+ (extend-var-env-4546
+ labels-8294
+ new-vars-8295
+ r-8202)))
+ (constructor-8206
+ s-8204
+ (map syntax->datum ids-8207)
+ new-vars-8295
+ (map (lambda (x-8314)
+ (expand-4586 x-8314 r-8202 w-8203 mod-8205))
+ vals-8208)
+ (expand-body-4590
+ exps-8209
+ (source-wrap-4580 e-8201 nw-8296 s-8204 mod-8205)
+ nr-8297
+ nw-8296
+ mod-8205))))))))
+ (lambda (e-7992 r-7993 w-7994 s-7995 mod-7996)
+ (let ((tmp-7998
($sc-dispatch
- e-8924
+ e-7992
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-8930
+ (if (if tmp-7998
(@apply
- (lambda (id-8934 val-8935 e1-8936 e2-8937)
- (and-map id?-6549 id-8934))
- tmp-8930)
+ (lambda (id-8002 val-8003 e1-8004 e2-8005)
+ (and-map id?-4550 id-8002))
+ tmp-7998)
#f)
(@apply
- (lambda (id-8953 val-8954 e1-8955 e2-8956)
- (expand-let-8923
- e-8924
- r-8925
- w-8926
- s-8927
- mod-8928
- build-let-6531
- id-8953
- val-8954
- (cons e1-8955 e2-8956)))
- tmp-8930)
- (let ((tmp-8986
+ (lambda (id-8021 val-8022 e1-8023 e2-8024)
+ (expand-let-7991
+ e-7992
+ r-7993
+ w-7994
+ s-7995
+ mod-7996
+ (lambda (src-8028
+ ids-8029
+ vars-8030
+ val-exps-8031
+ body-exp-8032)
+ (begin
+ (for-each
+ maybe-name-value!-4515
+ ids-8029
+ val-exps-8031)
+ (if (null? vars-8030)
+ body-exp-8032
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 16)
+ src-8028
+ ids-8029
+ vars-8030
+ val-exps-8031
+ body-exp-8032))))
+ id-8021
+ val-8022
+ (cons e1-8023 e2-8024)))
+ tmp-7998)
+ (let ((tmp-8039
($sc-dispatch
- e-8924
+ e-7992
'(_ any #(each (any any)) any . each-any))))
- (if (if tmp-8986
+ (if (if tmp-8039
(@apply
- (lambda (f-8990 id-8991 val-8992 e1-8993 e2-8994)
- (if (if (symbol? f-8990)
+ (lambda (f-8043 id-8044 val-8045 e1-8046 e2-8047)
+ (if (if (symbol? f-8043)
#t
- (if (if (vector? f-8990)
- (if (= (vector-length f-8990) 4)
- (eq? (vector-ref f-8990 0)
+ (if (if (vector? f-8043)
+ (if (= (vector-length f-8043) 4)
+ (eq? (vector-ref f-8043 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref f-8990 1))
+ (symbol? (vector-ref f-8043 1))
#f))
- (and-map id?-6549 id-8991)
+ (and-map id?-4550 id-8044)
#f))
- tmp-8986)
+ tmp-8039)
#f)
(@apply
- (lambda (f-9036 id-9037 val-9038 e1-9039 e2-9040)
- (expand-let-8923
- e-8924
- r-8925
- w-8926
- s-8927
- mod-8928
- build-named-let-6532
- (cons f-9036 id-9037)
- val-9038
- (cons e1-9039 e2-9040)))
- tmp-8986)
+ (lambda (f-8089 id-8090 val-8091 e1-8092 e2-8093)
+ (expand-let-7991
+ e-7992
+ r-7993
+ w-7994
+ s-7995
+ mod-7996
+ build-named-let-4534
+ (cons f-8089 id-8090)
+ val-8091
+ (cons e1-8092 e2-8093)))
+ tmp-8039)
(syntax-violation
'let
"bad let"
- (wrap-6578
- (begin
- (if (if (pair? e-8924) s-8927 #f)
- (set-source-properties! e-8924 s-8927))
- e-8924)
- w-8926
- mod-8928)))))))))
- (global-extend-6547
+ (let ((x-8106
+ (begin
+ (if (if (pair? e-7992) s-7995 #f)
+ (set-source-properties! e-7992 s-7995))
+ e-7992)))
+ (if (if (null? (car w-7994)) (null? (cdr w-7994)) #f)
+ x-8106
+ (if (if (vector? x-8106)
+ (if (= (vector-length x-8106) 4)
+ (eq? (vector-ref x-8106 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-8138 (vector-ref x-8106 1))
+ (wrap-8139
+ (let ((w2-8147 (vector-ref x-8106 2)))
+ (let ((m1-8148 (car w-7994))
+ (s1-8149 (cdr w-7994)))
+ (if (null? m1-8148)
+ (if (null? s1-8149)
+ w2-8147
+ (cons (car w2-8147)
+ (let ((m2-8164
+ (cdr w2-8147)))
+ (if (null? m2-8164)
+ s1-8149
+ (append
+ s1-8149
+ m2-8164)))))
+ (cons (let ((m2-8172 (car w2-8147)))
+ (if (null? m2-8172)
+ m1-8148
+ (append m1-8148 m2-8172)))
+ (let ((m2-8180 (cdr w2-8147)))
+ (if (null? m2-8180)
+ s1-8149
+ (append
+ s1-8149
+ m2-8180))))))))
+ (module-8140 (vector-ref x-8106 3)))
+ (vector
+ 'syntax-object
+ expression-8138
+ wrap-8139
+ module-8140))
+ (if (null? x-8106)
+ x-8106
+ (vector
+ 'syntax-object
+ x-8106
+ w-7994
+ mod-7996)))))))))))))
+ (global-extend-4548
'core
'letrec
- (lambda (e-9590 r-9591 w-9592 s-9593 mod-9594)
- (let ((tmp-9596
+ (lambda (e-8744 r-8745 w-8746 s-8747 mod-8748)
+ (let ((tmp-8750
($sc-dispatch
- e-9590
+ e-8744
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-9596
+ (if (if tmp-8750
(@apply
- (lambda (id-9600 val-9601 e1-9602 e2-9603)
- (and-map id?-6549 id-9600))
- tmp-9596)
+ (lambda (id-8754 val-8755 e1-8756 e2-8757)
+ (and-map id?-4550 id-8754))
+ tmp-8750)
#f)
(@apply
- (lambda (id-9619 val-9620 e1-9621 e2-9622)
- (if (not (valid-bound-ids?-6575 id-9619))
+ (lambda (id-8773 val-8774 e1-8775 e2-8776)
+ (if (not (valid-bound-ids?-4576 id-8773))
(syntax-violation
'letrec
"duplicate bound variable"
- e-9590)
- (let ((labels-9712 (gen-labels-6552 id-9619))
- (new-vars-9713 (map gen-var-6599 id-9619)))
- (let ((w-9714
- (make-binding-wrap-6563
- id-9619
- labels-9712
- w-9592))
- (r-9715
- (extend-var-env-6544
- labels-9712
- new-vars-9713
- r-9591)))
- (build-letrec-6533
- s-9593
+ e-8744)
+ (let ((labels-8873 (gen-labels-4553 id-8773))
+ (new-vars-8874 (map gen-var-4600 id-8773)))
+ (let ((w-8875
+ (make-binding-wrap-4564
+ id-8773
+ labels-8873
+ w-8746))
+ (r-8876
+ (extend-var-env-4546
+ labels-8873
+ new-vars-8874
+ r-8745)))
+ (build-letrec-4535
+ s-8747
#f
- (map syntax->datum id-9619)
- new-vars-9713
- (map (lambda (x-9800)
- (expand-6585 x-9800 r-9715 w-9714 mod-9594))
- val-9620)
- (expand-body-6589
- (cons e1-9621 e2-9622)
- (wrap-6578
- (begin
- (if (if (pair? e-9590) s-9593 #f)
- (set-source-properties! e-9590 s-9593))
- e-9590)
- w-9714
- mod-9594)
- r-9715
- w-9714
- mod-9594))))))
- tmp-9596)
+ (map syntax->datum id-8773)
+ new-vars-8874
+ (map (lambda (x-8953)
+ (expand-4586 x-8953 r-8876 w-8875 mod-8748))
+ val-8774)
+ (expand-body-4590
+ (cons e1-8775 e2-8776)
+ (let ((x-9015
+ (begin
+ (if (if (pair? e-8744) s-8747 #f)
+ (set-source-properties! e-8744 s-8747))
+ e-8744)))
+ (if (if (null? (car w-8875))
+ (null? (cdr w-8875))
+ #f)
+ x-9015
+ (if (if (vector? x-9015)
+ (if (= (vector-length x-9015) 4)
+ (eq? (vector-ref x-9015 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-9047 (vector-ref x-9015 1))
+ (wrap-9048
+ (let ((w2-9056
+ (vector-ref x-9015 2)))
+ (let ((m1-9057 (car w-8875))
+ (s1-9058 (cdr w-8875)))
+ (if (null? m1-9057)
+ (if (null? s1-9058)
+ w2-9056
+ (cons (car w2-9056)
+ (let ((m2-9073
+ (cdr w2-9056)))
+ (if (null? m2-9073)
+ s1-9058
+ (append
+ s1-9058
+ m2-9073)))))
+ (cons (let ((m2-9081
+ (car w2-9056)))
+ (if (null? m2-9081)
+ m1-9057
+ (append
+ m1-9057
+ m2-9081)))
+ (let ((m2-9089
+ (cdr w2-9056)))
+ (if (null? m2-9089)
+ s1-9058
+ (append
+ s1-9058
+ m2-9089))))))))
+ (module-9049 (vector-ref x-9015 3)))
+ (vector
+ 'syntax-object
+ expression-9047
+ wrap-9048
+ module-9049))
+ (if (null? x-9015)
+ x-9015
+ (vector
+ 'syntax-object
+ x-9015
+ w-8875
+ mod-8748)))))
+ r-8876
+ w-8875
+ mod-8748))))))
+ tmp-8750)
(syntax-violation
'letrec
"bad letrec"
- (wrap-6578
- (begin
- (if (if (pair? e-9590) s-9593 #f)
- (set-source-properties! e-9590 s-9593))
- e-9590)
- w-9592
- mod-9594))))))
- (global-extend-6547
+ (let ((x-9300
+ (begin
+ (if (if (pair? e-8744) s-8747 #f)
+ (set-source-properties! e-8744 s-8747))
+ e-8744)))
+ (if (if (null? (car w-8746)) (null? (cdr w-8746)) #f)
+ x-9300
+ (if (if (vector? x-9300)
+ (if (= (vector-length x-9300) 4)
+ (eq? (vector-ref x-9300 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-9332 (vector-ref x-9300 1))
+ (wrap-9333
+ (let ((w2-9341 (vector-ref x-9300 2)))
+ (let ((m1-9342 (car w-8746))
+ (s1-9343 (cdr w-8746)))
+ (if (null? m1-9342)
+ (if (null? s1-9343)
+ w2-9341
+ (cons (car w2-9341)
+ (let ((m2-9358 (cdr w2-9341)))
+ (if (null? m2-9358)
+ s1-9343
+ (append s1-9343 m2-9358)))))
+ (cons (let ((m2-9366 (car w2-9341)))
+ (if (null? m2-9366)
+ m1-9342
+ (append m1-9342 m2-9366)))
+ (let ((m2-9374 (cdr w2-9341)))
+ (if (null? m2-9374)
+ s1-9343
+ (append s1-9343 m2-9374))))))))
+ (module-9334 (vector-ref x-9300 3)))
+ (vector
+ 'syntax-object
+ expression-9332
+ wrap-9333
+ module-9334))
+ (if (null? x-9300)
+ x-9300
+ (vector 'syntax-object x-9300 w-8746 mod-8748))))))))))
+ (global-extend-4548
'core
'letrec*
- (lambda (e-10195 r-10196 w-10197 s-10198 mod-10199)
- (let ((tmp-10201
+ (lambda (e-9525 r-9526 w-9527 s-9528 mod-9529)
+ (let ((tmp-9531
($sc-dispatch
- e-10195
+ e-9525
'(_ #(each (any any)) any . each-any))))
- (if (if tmp-10201
+ (if (if tmp-9531
(@apply
- (lambda (id-10205 val-10206 e1-10207 e2-10208)
- (and-map id?-6549 id-10205))
- tmp-10201)
+ (lambda (id-9535 val-9536 e1-9537 e2-9538)
+ (and-map id?-4550 id-9535))
+ tmp-9531)
#f)
(@apply
- (lambda (id-10224 val-10225 e1-10226 e2-10227)
- (if (not (valid-bound-ids?-6575 id-10224))
+ (lambda (id-9554 val-9555 e1-9556 e2-9557)
+ (if (not (valid-bound-ids?-4576 id-9554))
(syntax-violation
'letrec*
"duplicate bound variable"
- e-10195)
- (let ((labels-10317 (gen-labels-6552 id-10224))
- (new-vars-10318 (map gen-var-6599 id-10224)))
- (let ((w-10319
- (make-binding-wrap-6563
- id-10224
- labels-10317
- w-10197))
- (r-10320
- (extend-var-env-6544
- labels-10317
- new-vars-10318
- r-10196)))
- (build-letrec-6533
- s-10198
+ e-9525)
+ (let ((labels-9654 (gen-labels-4553 id-9554))
+ (new-vars-9655 (map gen-var-4600 id-9554)))
+ (let ((w-9656
+ (make-binding-wrap-4564
+ id-9554
+ labels-9654
+ w-9527))
+ (r-9657
+ (extend-var-env-4546
+ labels-9654
+ new-vars-9655
+ r-9526)))
+ (build-letrec-4535
+ s-9528
#t
- (map syntax->datum id-10224)
- new-vars-10318
- (map (lambda (x-10405)
- (expand-6585
- x-10405
- r-10320
- w-10319
- mod-10199))
- val-10225)
- (expand-body-6589
- (cons e1-10226 e2-10227)
- (wrap-6578
- (begin
- (if (if (pair? e-10195) s-10198 #f)
- (set-source-properties! e-10195 s-10198))
- e-10195)
- w-10319
- mod-10199)
- r-10320
- w-10319
- mod-10199))))))
- tmp-10201)
+ (map syntax->datum id-9554)
+ new-vars-9655
+ (map (lambda (x-9734)
+ (expand-4586 x-9734 r-9657 w-9656 mod-9529))
+ val-9555)
+ (expand-body-4590
+ (cons e1-9556 e2-9557)
+ (let ((x-9796
+ (begin
+ (if (if (pair? e-9525) s-9528 #f)
+ (set-source-properties! e-9525 s-9528))
+ e-9525)))
+ (if (if (null? (car w-9656))
+ (null? (cdr w-9656))
+ #f)
+ x-9796
+ (if (if (vector? x-9796)
+ (if (= (vector-length x-9796) 4)
+ (eq? (vector-ref x-9796 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-9828 (vector-ref x-9796 1))
+ (wrap-9829
+ (let ((w2-9837
+ (vector-ref x-9796 2)))
+ (let ((m1-9838 (car w-9656))
+ (s1-9839 (cdr w-9656)))
+ (if (null? m1-9838)
+ (if (null? s1-9839)
+ w2-9837
+ (cons (car w2-9837)
+ (let ((m2-9854
+ (cdr w2-9837)))
+ (if (null? m2-9854)
+ s1-9839
+ (append
+ s1-9839
+ m2-9854)))))
+ (cons (let ((m2-9862
+ (car w2-9837)))
+ (if (null? m2-9862)
+ m1-9838
+ (append
+ m1-9838
+ m2-9862)))
+ (let ((m2-9870
+ (cdr w2-9837)))
+ (if (null? m2-9870)
+ s1-9839
+ (append
+ s1-9839
+ m2-9870))))))))
+ (module-9830 (vector-ref x-9796 3)))
+ (vector
+ 'syntax-object
+ expression-9828
+ wrap-9829
+ module-9830))
+ (if (null? x-9796)
+ x-9796
+ (vector
+ 'syntax-object
+ x-9796
+ w-9656
+ mod-9529)))))
+ r-9657
+ w-9656
+ mod-9529))))))
+ tmp-9531)
(syntax-violation
'letrec*
"bad letrec*"
- (wrap-6578
- (begin
- (if (if (pair? e-10195) s-10198 #f)
- (set-source-properties! e-10195 s-10198))
- e-10195)
- w-10197
- mod-10199))))))
- (global-extend-6547
+ (let ((x-10081
+ (begin
+ (if (if (pair? e-9525) s-9528 #f)
+ (set-source-properties! e-9525 s-9528))
+ e-9525)))
+ (if (if (null? (car w-9527)) (null? (cdr w-9527)) #f)
+ x-10081
+ (if (if (vector? x-10081)
+ (if (= (vector-length x-10081) 4)
+ (eq? (vector-ref x-10081 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10113 (vector-ref x-10081 1))
+ (wrap-10114
+ (let ((w2-10122 (vector-ref x-10081 2)))
+ (let ((m1-10123 (car w-9527))
+ (s1-10124 (cdr w-9527)))
+ (if (null? m1-10123)
+ (if (null? s1-10124)
+ w2-10122
+ (cons (car w2-10122)
+ (let ((m2-10139 (cdr w2-10122)))
+ (if (null? m2-10139)
+ s1-10124
+ (append s1-10124 m2-10139)))))
+ (cons (let ((m2-10147 (car w2-10122)))
+ (if (null? m2-10147)
+ m1-10123
+ (append m1-10123 m2-10147)))
+ (let ((m2-10155 (cdr w2-10122)))
+ (if (null? m2-10155)
+ s1-10124
+ (append s1-10124 m2-10155))))))))
+ (module-10115 (vector-ref x-10081 3)))
+ (vector
+ 'syntax-object
+ expression-10113
+ wrap-10114
+ module-10115))
+ (if (null? x-10081)
+ x-10081
+ (vector
+ 'syntax-object
+ x-10081
+ w-9527
+ mod-9529))))))))))
+ (global-extend-4548
'core
'set!
- (lambda (e-10839 r-10840 w-10841 s-10842 mod-10843)
- (let ((tmp-10845 ($sc-dispatch e-10839 '(_ any any))))
- (if (if tmp-10845
+ (lambda (e-10314 r-10315 w-10316 s-10317 mod-10318)
+ (let ((tmp-10320 ($sc-dispatch e-10314 '(_ any any))))
+ (if (if tmp-10320
(@apply
- (lambda (id-10849 val-10850)
- (if (symbol? id-10849)
+ (lambda (id-10324 val-10325)
+ (if (symbol? id-10324)
#t
- (if (if (vector? id-10849)
- (if (= (vector-length id-10849) 4)
- (eq? (vector-ref id-10849 0) 'syntax-object)
+ (if (if (vector? id-10324)
+ (if (= (vector-length id-10324) 4)
+ (eq? (vector-ref id-10324 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-10849 1))
+ (symbol? (vector-ref id-10324 1))
#f)))
- tmp-10845)
+ tmp-10320)
#f)
(@apply
- (lambda (id-10877 val-10878)
- (let ((n-10879 (id-var-name-6568 id-10877 w-10841))
- (id-mod-10880
- (if (if (vector? id-10877)
- (if (= (vector-length id-10877) 4)
- (eq? (vector-ref id-10877 0) 'syntax-object)
- #f)
- #f)
- (vector-ref id-10877 3)
- mod-10843)))
- (let ((b-10881
- (let ((t-10922 (assq n-10879 r-10840)))
- (if t-10922
- (cdr t-10922)
- (if (symbol? n-10879)
- (let ((t-10927
- (get-global-definition-hook-6512
- n-10879
- id-mod-10880)))
- (if t-10927 t-10927 '(global)))
- '(displaced-lexical))))))
- (let ((atom-key-10882 (car b-10881)))
- (if (eqv? atom-key-10882 'lexical)
- (build-lexical-assignment-6520
- s-10842
- (syntax->datum id-10877)
- (cdr b-10881)
- (expand-6585 val-10878 r-10840 w-10841 mod-10843))
- (if (eqv? atom-key-10882 'global)
- (build-global-assignment-6523
- s-10842
- n-10879
- (expand-6585 val-10878 r-10840 w-10841 mod-10843)
- id-mod-10880)
- (if (eqv? atom-key-10882 'macro)
- (let ((p-11241 (cdr b-10881)))
- (if (procedure-property
- p-11241
- 'variable-transformer)
- (expand-6585
- (expand-macro-6588
- p-11241
- e-10839
- r-10840
- w-10841
- s-10842
- #f
- mod-10843)
- r-10840
- '(())
- mod-10843)
- (syntax-violation
- 'set!
- "not a variable transformer"
- (wrap-6578 e-10839 w-10841 mod-10843)
- (wrap-6578
- id-10877
- w-10841
- id-mod-10880))))
- (if (eqv? atom-key-10882 'displaced-lexical)
- (syntax-violation
- 'set!
- "identifier out of context"
- (wrap-6578 id-10877 w-10841 mod-10843))
- (syntax-violation
- 'set!
- "bad set!"
- (wrap-6578
- (begin
- (if (if (pair? e-10839) s-10842 #f)
- (set-source-properties!
- e-10839
- s-10842))
- e-10839)
- w-10841
- mod-10843))))))))))
- tmp-10845)
- (let ((tmp-11336
- ($sc-dispatch e-10839 '(_ (any . each-any) any))))
- (if tmp-11336
+ (lambda (id-10352 val-10353)
+ (call-with-values
+ (lambda ()
+ (resolve-identifier-4571
+ id-10352
+ w-10316
+ r-10315
+ mod-10318
+ #t))
+ (lambda (type-10356 value-10357 id-mod-10358)
+ (if (eqv? type-10356 'lexical)
+ (build-lexical-assignment-4521
+ s-10317
+ (syntax->datum id-10352)
+ value-10357
+ (expand-4586 val-10353 r-10315 w-10316 mod-10318))
+ (if (eqv? type-10356 'global)
+ (build-global-assignment-4524
+ s-10317
+ value-10357
+ (expand-4586 val-10353 r-10315 w-10316 mod-10318)
+ id-mod-10358)
+ (if (eqv? type-10356 'macro)
+ (if (procedure-property
+ value-10357
+ 'variable-transformer)
+ (expand-4586
+ (expand-macro-4589
+ value-10357
+ e-10314
+ r-10315
+ w-10316
+ s-10317
+ #f
+ mod-10318)
+ r-10315
+ '(())
+ mod-10318)
+ (syntax-violation
+ 'set!
+ "not a variable transformer"
+ (if (if (null? (car w-10316))
+ (null? (cdr w-10316))
+ #f)
+ e-10314
+ (if (if (vector? e-10314)
+ (if (= (vector-length e-10314) 4)
+ (eq? (vector-ref e-10314 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10798
+ (vector-ref e-10314 1))
+ (wrap-10799
+ (let ((w2-10809
+ (vector-ref e-10314 2)))
+ (let ((m1-10810 (car w-10316))
+ (s1-10811 (cdr w-10316)))
+ (if (null? m1-10810)
+ (if (null? s1-10811)
+ w2-10809
+ (cons (car w2-10809)
+ (let ((m2-10828
+ (cdr w2-10809)))
+ (if (null? m2-10828)
+ s1-10811
+ (append
+ s1-10811
+ m2-10828)))))
+ (cons (let ((m2-10836
+ (car w2-10809)))
+ (if (null? m2-10836)
+ m1-10810
+ (append
+ m1-10810
+ m2-10836)))
+ (let ((m2-10844
+ (cdr w2-10809)))
+ (if (null? m2-10844)
+ s1-10811
+ (append
+ s1-10811
+ m2-10844))))))))
+ (module-10800
+ (vector-ref e-10314 3)))
+ (vector
+ 'syntax-object
+ expression-10798
+ wrap-10799
+ module-10800))
+ (if (null? e-10314)
+ e-10314
+ (vector
+ 'syntax-object
+ e-10314
+ w-10316
+ mod-10318))))
+ (if (if (null? (car w-10316))
+ (null? (cdr w-10316))
+ #f)
+ id-10352
+ (if (if (vector? id-10352)
+ (if (= (vector-length id-10352) 4)
+ (eq? (vector-ref id-10352 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10896
+ (vector-ref id-10352 1))
+ (wrap-10897
+ (let ((w2-10907
+ (vector-ref id-10352 2)))
+ (let ((m1-10908 (car w-10316))
+ (s1-10909 (cdr w-10316)))
+ (if (null? m1-10908)
+ (if (null? s1-10909)
+ w2-10907
+ (cons (car w2-10907)
+ (let ((m2-10926
+ (cdr w2-10907)))
+ (if (null? m2-10926)
+ s1-10909
+ (append
+ s1-10909
+ m2-10926)))))
+ (cons (let ((m2-10934
+ (car w2-10907)))
+ (if (null? m2-10934)
+ m1-10908
+ (append
+ m1-10908
+ m2-10934)))
+ (let ((m2-10942
+ (cdr w2-10907)))
+ (if (null? m2-10942)
+ s1-10909
+ (append
+ s1-10909
+ m2-10942))))))))
+ (module-10898
+ (vector-ref id-10352 3)))
+ (vector
+ 'syntax-object
+ expression-10896
+ wrap-10897
+ module-10898))
+ (if (null? id-10352)
+ id-10352
+ (vector
+ 'syntax-object
+ id-10352
+ w-10316
+ id-mod-10358))))))
+ (if (eqv? type-10356 'displaced-lexical)
+ (syntax-violation
+ 'set!
+ "identifier out of context"
+ (if (if (null? (car w-10316))
+ (null? (cdr w-10316))
+ #f)
+ id-10352
+ (if (if (vector? id-10352)
+ (if (= (vector-length id-10352) 4)
+ (eq? (vector-ref id-10352 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-10997
+ (vector-ref id-10352 1))
+ (wrap-10998
+ (let ((w2-11008
+ (vector-ref id-10352 2)))
+ (let ((m1-11009 (car w-10316))
+ (s1-11010 (cdr w-10316)))
+ (if (null? m1-11009)
+ (if (null? s1-11010)
+ w2-11008
+ (cons (car w2-11008)
+ (let ((m2-11027
+ (cdr w2-11008)))
+ (if (null? m2-11027)
+ s1-11010
+ (append
+ s1-11010
+ m2-11027)))))
+ (cons (let ((m2-11035
+ (car w2-11008)))
+ (if (null? m2-11035)
+ m1-11009
+ (append
+ m1-11009
+ m2-11035)))
+ (let ((m2-11043
+ (cdr w2-11008)))
+ (if (null? m2-11043)
+ s1-11010
+ (append
+ s1-11010
+ m2-11043))))))))
+ (module-10999
+ (vector-ref id-10352 3)))
+ (vector
+ 'syntax-object
+ expression-10997
+ wrap-10998
+ module-10999))
+ (if (null? id-10352)
+ id-10352
+ (vector
+ 'syntax-object
+ id-10352
+ w-10316
+ mod-10318)))))
+ (syntax-violation
+ 'set!
+ "bad set!"
+ (let ((x-11075
+ (begin
+ (if (if (pair? e-10314) s-10317 #f)
+ (set-source-properties!
+ e-10314
+ s-10317))
+ e-10314)))
+ (if (if (null? (car w-10316))
+ (null? (cdr w-10316))
+ #f)
+ x-11075
+ (if (if (vector? x-11075)
+ (if (= (vector-length x-11075) 4)
+ (eq? (vector-ref x-11075 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-11107
+ (vector-ref x-11075 1))
+ (wrap-11108
+ (let ((w2-11116
+ (vector-ref x-11075 2)))
+ (let ((m1-11117 (car w-10316))
+ (s1-11118 (cdr w-10316)))
+ (if (null? m1-11117)
+ (if (null? s1-11118)
+ w2-11116
+ (cons (car w2-11116)
+ (let ((m2-11133
+ (cdr w2-11116)))
+ (if (null? m2-11133)
+ s1-11118
+ (append
+ s1-11118
+ m2-11133)))))
+ (cons (let ((m2-11141
+ (car w2-11116)))
+ (if (null? m2-11141)
+ m1-11117
+ (append
+ m1-11117
+ m2-11141)))
+ (let ((m2-11149
+ (cdr w2-11116)))
+ (if (null? m2-11149)
+ s1-11118
+ (append
+ s1-11118
+ m2-11149))))))))
+ (module-11109
+ (vector-ref x-11075 3)))
+ (vector
+ 'syntax-object
+ expression-11107
+ wrap-11108
+ module-11109))
+ (if (null? x-11075)
+ x-11075
+ (vector
+ 'syntax-object
+ x-11075
+ w-10316
+ mod-10318)))))))))))))
+ tmp-10320)
+ (let ((tmp-11164
+ ($sc-dispatch e-10314 '(_ (any . each-any) any))))
+ (if tmp-11164
(@apply
- (lambda (head-11340 tail-11341 val-11342)
+ (lambda (head-11168 tail-11169 val-11170)
(call-with-values
(lambda ()
- (syntax-type-6584
- head-11340
- r-10840
+ (syntax-type-4585
+ head-11168
+ r-10315
'(())
#f
#f
- mod-10843
+ mod-10318
#t))
- (lambda (type-11345
- value-11346
- formform-11347
- ee-11348
- ww-11349
- ss-11350
- modmod-11351)
- (if (eqv? type-11345 'module-ref)
- (let ((val-11355
- (expand-6585
- val-11342
- r-10840
- w-10841
- mod-10843)))
+ (lambda (type-11173
+ value-11174
+ ee*-11175
+ ee-11176
+ ww-11177
+ ss-11178
+ modmod-11179)
+ (if (eqv? type-11173 'module-ref)
+ (let ((val-11183
+ (expand-4586
+ val-11170
+ r-10315
+ w-10316
+ mod-10318)))
(call-with-values
(lambda ()
- (value-11346
- (cons head-11340 tail-11341)
- r-10840
- w-10841))
- (lambda (e-11356
- r-11357
- w-11358
- s*-11359
- mod-11360)
- (let ((tmp-11362 (list e-11356)))
+ (value-11174
+ (cons head-11168 tail-11169)
+ r-10315
+ w-10316))
+ (lambda (e-11184
+ r-11185
+ w-11186
+ s*-11187
+ mod-11188)
+ (let ((tmp-11190 (list e-11184)))
(if (@apply
- (lambda (e-11364)
- (if (symbol? e-11364)
+ (lambda (e-11192)
+ (if (symbol? e-11192)
#t
- (if (if (vector? e-11364)
+ (if (if (vector? e-11192)
(if (= (vector-length
- e-11364)
+ e-11192)
4)
(eq? (vector-ref
- e-11364
+ e-11192
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref e-11364 1))
+ (vector-ref e-11192 1))
#f)))
- tmp-11362)
+ tmp-11190)
(@apply
- (lambda (e-11394)
- (build-global-assignment-6523
- s-10842
- (syntax->datum e-11394)
- val-11355
- mod-11360))
- tmp-11362)
+ (lambda (e-11222)
+ (build-global-assignment-4524
+ s-10317
+ (syntax->datum e-11222)
+ val-11183
+ mod-11188))
+ tmp-11190)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-11356))))))
- (build-application-6516
- s-10842
- (let ((e-11619
- (list '#(syntax-object
- setter
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(type
- value
- formform
- ee
- ww
- ss
- modmod)
- #((top)
- (top)
- (top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-5730"
- "l-*-5731"
- "l-*-5732"
- "l-*-5733"
- "l-*-5734"
- "l-*-5735"
- "l-*-5736"))
- #(ribcage
- #(head tail val)
- #((top) (top) (top))
- #("l-*-5715"
- "l-*-5716"
- "l-*-5717"))
- #(ribcage () () ())
- #(ribcage
- #(e r w s mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-5679"
- "l-*-5680"
- "l-*-5681"
- "l-*-5682"
- "l-*-5683"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- head-11340)))
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-11619
- r-10840
- w-10841
- (source-annotation-6542 e-11619)
- #f
- mod-10843
- #f))
- (lambda (type-11626
- value-11627
- form-11628
- e-11629
- w-11630
- s-11631
- mod-11632)
- (expand-expr-6586
- type-11626
- value-11627
- form-11628
- e-11629
- r-10840
- w-11630
- s-11631
- mod-11632))))
- (map (lambda (e-11636)
- (call-with-values
- (lambda ()
- (syntax-type-6584
- e-11636
- r-10840
- w-10841
- (source-annotation-6542 e-11636)
- #f
- mod-10843
- #f))
- (lambda (type-11651
- value-11652
- form-11653
- e-11654
- w-11655
- s-11656
- mod-11657)
- (expand-expr-6586
- type-11651
- value-11652
- form-11653
- e-11654
- r-10840
- w-11655
- s-11656
- mod-11657))))
- (append tail-11341 (list val-11342))))))))
- tmp-11336)
+ e-11184))))))
+ (build-call-4517
+ s-10317
+ (expand-4586
+ (list '#(syntax-object
+ setter
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(type value ee* ee ww ss modmod)
+ #((top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top)
+ (top))
+ #("l-*-3734"
+ "l-*-3735"
+ "l-*-3736"
+ "l-*-3737"
+ "l-*-3738"
+ "l-*-3739"
+ "l-*-3740"))
+ #(ribcage
+ #(head tail val)
+ #((top) (top) (top))
+ #("l-*-3719"
+ "l-*-3720"
+ "l-*-3721"))
+ #(ribcage () () ())
+ #(ribcage
+ #(e r w s mod)
+ #((top) (top) (top) (top) (top))
+ #("l-*-3691"
+ "l-*-3692"
+ "l-*-3693"
+ "l-*-3694"
+ "l-*-3695"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile))
+ head-11168)
+ r-10315
+ w-10316
+ mod-10318)
+ (map (lambda (e-11535)
+ (expand-4586
+ e-11535
+ r-10315
+ w-10316
+ mod-10318))
+ (append tail-11169 (list val-11170))))))))
+ tmp-11164)
(syntax-violation
'set!
"bad set!"
- (wrap-6578
- (begin
- (if (if (pair? e-10839) s-10842 #f)
- (set-source-properties! e-10839 s-10842))
- e-10839)
- w-10841
- mod-10843))))))))
+ (let ((x-11623
+ (begin
+ (if (if (pair? e-10314) s-10317 #f)
+ (set-source-properties! e-10314 s-10317))
+ e-10314)))
+ (if (if (null? (car w-10316))
+ (null? (cdr w-10316))
+ #f)
+ x-11623
+ (if (if (vector? x-11623)
+ (if (= (vector-length x-11623) 4)
+ (eq? (vector-ref x-11623 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-11655 (vector-ref x-11623 1))
+ (wrap-11656
+ (let ((w2-11664 (vector-ref x-11623 2)))
+ (let ((m1-11665 (car w-10316))
+ (s1-11666 (cdr w-10316)))
+ (if (null? m1-11665)
+ (if (null? s1-11666)
+ w2-11664
+ (cons (car w2-11664)
+ (let ((m2-11681
+ (cdr w2-11664)))
+ (if (null? m2-11681)
+ s1-11666
+ (append
+ s1-11666
+ m2-11681)))))
+ (cons (let ((m2-11689 (car w2-11664)))
+ (if (null? m2-11689)
+ m1-11665
+ (append m1-11665 m2-11689)))
+ (let ((m2-11697 (cdr w2-11664)))
+ (if (null? m2-11697)
+ s1-11666
+ (append
+ s1-11666
+ m2-11697))))))))
+ (module-11657 (vector-ref x-11623 3)))
+ (vector
+ 'syntax-object
+ expression-11655
+ wrap-11656
+ module-11657))
+ (if (null? x-11623)
+ x-11623
+ (vector
+ 'syntax-object
+ x-11623
+ w-10316
+ mod-10318))))))))))))
(module-define!
(current-module)
'@
(make-syntax-transformer
'@
'module-ref
- (lambda (e-11700 r-11701 w-11702)
- (let ((tmp-11704
- ($sc-dispatch e-11700 '(_ each-any any))))
- (if (if tmp-11704
+ (lambda (e-11728 r-11729 w-11730)
+ (let ((tmp-11732
+ ($sc-dispatch e-11728 '(_ each-any any))))
+ (if (if tmp-11732
(@apply
- (lambda (mod-11707 id-11708)
- (if (and-map id?-6549 mod-11707)
- (if (symbol? id-11708)
+ (lambda (mod-11735 id-11736)
+ (if (and-map id?-4550 mod-11735)
+ (if (symbol? id-11736)
#t
- (if (if (vector? id-11708)
- (if (= (vector-length id-11708) 4)
- (eq? (vector-ref id-11708 0)
+ (if (if (vector? id-11736)
+ (if (= (vector-length id-11736) 4)
+ (eq? (vector-ref id-11736 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-11708 1))
+ (symbol? (vector-ref id-11736 1))
#f))
#f))
- tmp-11704)
+ tmp-11732)
#f)
(@apply
- (lambda (mod-11748 id-11749)
+ (lambda (mod-11776 id-11777)
(values
- (syntax->datum id-11749)
- r-11701
- w-11702
+ (syntax->datum id-11777)
+ r-11729
+ w-11730
#f
(syntax->datum
(cons '#(syntax-object
@@ -9862,12 +11715,12 @@
#(ribcage
#(mod id)
#((top) (top))
- #("l-*-5778" "l-*-5779"))
+ #("l-*-3782" "l-*-3783"))
#(ribcage () () ())
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-5766" "l-*-5767" "l-*-5768"))
+ #("l-*-3770" "l-*-3771" "l-*-3772"))
#(ribcage
(lambda-var-list
gen-var
@@ -9882,7 +11735,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -9938,7 +11791,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -9964,6 +11816,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -9975,7 +11828,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -9996,8 +11849,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -10148,214 +12002,217 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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-*-2098" "l-*-2097" "l-*-2096")))
+ ("l-*-47" "l-*-46" "l-*-45"))
+ #(ribcage () () ()))
(hygiene guile))
- mod-11748))))
- tmp-11704)
+ mod-11776))))
+ tmp-11732)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-11700))))))
- (global-extend-6547
+ e-11728))))))
+ (global-extend-4548
'module-ref
'@@
- (lambda (e-11841 r-11842 w-11843)
+ (lambda (e-11877 r-11878 w-11879)
(letrec*
- ((remodulate-11844
- (lambda (x-11879 mod-11880)
- (if (pair? x-11879)
- (cons (remodulate-11844 (car x-11879) mod-11880)
- (remodulate-11844 (cdr x-11879) mod-11880))
- (if (if (vector? x-11879)
- (if (= (vector-length x-11879) 4)
- (eq? (vector-ref x-11879 0) 'syntax-object)
+ ((remodulate-11880
+ (lambda (x-12098 mod-12099)
+ (if (pair? x-12098)
+ (cons (remodulate-11880 (car x-12098) mod-12099)
+ (remodulate-11880 (cdr x-12098) mod-12099))
+ (if (if (vector? x-12098)
+ (if (= (vector-length x-12098) 4)
+ (eq? (vector-ref x-12098 0) 'syntax-object)
#f)
#f)
- (let ((expression-11894
- (remodulate-11844
- (vector-ref x-11879 1)
- mod-11880))
- (wrap-11895 (vector-ref x-11879 2)))
+ (let ((expression-12113
+ (remodulate-11880
+ (vector-ref x-12098 1)
+ mod-12099))
+ (wrap-12114 (vector-ref x-12098 2)))
(vector
'syntax-object
- expression-11894
- wrap-11895
- mod-11880))
- (if (vector? x-11879)
- (let ((n-11903 (vector-length x-11879)))
- (let ((v-11904 (make-vector n-11903)))
+ expression-12113
+ wrap-12114
+ mod-12099))
+ (if (vector? x-12098)
+ (let ((n-12122 (vector-length x-12098)))
+ (let ((v-12123 (make-vector n-12122)))
(letrec*
- ((loop-11905
- (lambda (i-11952)
- (if (= i-11952 n-11903)
- v-11904
+ ((loop-12124
+ (lambda (i-12179)
+ (if (= i-12179 n-12122)
+ v-12123
(begin
(vector-set!
- v-11904
- i-11952
- (remodulate-11844
- (vector-ref x-11879 i-11952)
- mod-11880))
- (loop-11905 (#{1+}# i-11952)))))))
- (loop-11905 0))))
- x-11879))))))
- (let ((tmp-11846
- ($sc-dispatch e-11841 '(_ each-any any))))
- (if (if tmp-11846
+ v-12123
+ i-12179
+ (remodulate-11880
+ (vector-ref x-12098 i-12179)
+ mod-12099))
+ (loop-12124 (#{1+}# i-12179)))))))
+ (loop-12124 0))))
+ x-12098))))))
+ (let ((tmp-11882
+ ($sc-dispatch e-11877 '(_ each-any any))))
+ (if (if tmp-11882
(@apply
- (lambda (mod-11850 exp-11851)
- (and-map id?-6549 mod-11850))
- tmp-11846)
+ (lambda (mod-11886 exp-11887)
+ (and-map id?-4550 mod-11886))
+ tmp-11882)
#f)
(@apply
- (lambda (mod-11867 exp-11868)
- (let ((mod-11869
+ (lambda (mod-11903 exp-11904)
+ (let ((mod-11905
(syntax->datum
(cons '#(syntax-object
private
@@ -10363,15 +12220,15 @@
#(ribcage
#(mod exp)
#((top) (top))
- #("l-*-5822" "l-*-5823"))
+ #("l-*-3826" "l-*-3827"))
#(ribcage
(remodulate)
((top))
- ("l-*-5789"))
+ ("l-*-3793"))
#(ribcage
#(e r w)
#((top) (top) (top))
- #("l-*-5786" "l-*-5787" "l-*-5788"))
+ #("l-*-3790" "l-*-3791" "l-*-3792"))
#(ribcage
(lambda-var-list
gen-var
@@ -10386,7 +12243,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -10442,7 +12299,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -10468,6 +12324,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -10479,7 +12336,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -10500,8 +12357,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -10652,253 +12510,306 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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-*-2098" "l-*-2097" "l-*-2096")))
+ ("l-*-47" "l-*-46" "l-*-45"))
+ #(ribcage () () ()))
(hygiene guile))
- mod-11867))))
+ mod-11903))))
(values
- (remodulate-11844 exp-11868 mod-11869)
- r-11842
- w-11843
- (source-annotation-6542 exp-11868)
- mod-11869)))
- tmp-11846)
+ (remodulate-11880 exp-11904 mod-11905)
+ r-11878
+ w-11879
+ (source-annotation-4544 exp-11904)
+ mod-11905)))
+ tmp-11882)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-11841))))))
- (global-extend-6547
+ e-11877))))))
+ (global-extend-4548
'core
'if
- (lambda (e-12053 r-12054 w-12055 s-12056 mod-12057)
- (let ((tmp-12059 ($sc-dispatch e-12053 '(_ any any))))
- (if tmp-12059
+ (lambda (e-12288 r-12289 w-12290 s-12291 mod-12292)
+ (let ((tmp-12294 ($sc-dispatch e-12288 '(_ any any))))
+ (if tmp-12294
(@apply
- (lambda (test-12063 then-12064)
- (build-conditional-6517
- s-12056
- (expand-6585
- test-12063
- r-12054
- w-12055
- mod-12057)
- (expand-6585
- then-12064
- r-12054
- w-12055
- mod-12057)
+ (lambda (test-12298 then-12299)
+ (build-conditional-4518
+ s-12291
+ (expand-4586
+ test-12298
+ r-12289
+ w-12290
+ mod-12292)
+ (expand-4586
+ then-12299
+ r-12289
+ w-12290
+ mod-12292)
(make-struct/no-tail
(vector-ref %expanded-vtables 0)
#f)))
- tmp-12059)
- (let ((tmp-12289
- ($sc-dispatch e-12053 '(_ any any any))))
- (if tmp-12289
+ tmp-12294)
+ (let ((tmp-12548
+ ($sc-dispatch e-12288 '(_ any any any))))
+ (if tmp-12548
(@apply
- (lambda (test-12293 then-12294 else-12295)
- (build-conditional-6517
- s-12056
- (expand-6585
- test-12293
- r-12054
- w-12055
- mod-12057)
- (expand-6585
- then-12294
- r-12054
- w-12055
- mod-12057)
- (expand-6585
- else-12295
- r-12054
- w-12055
- mod-12057)))
- tmp-12289)
+ (lambda (test-12552 then-12553 else-12554)
+ (build-conditional-4518
+ s-12291
+ (expand-4586
+ test-12552
+ r-12289
+ w-12290
+ mod-12292)
+ (expand-4586
+ then-12553
+ r-12289
+ w-12290
+ mod-12292)
+ (expand-4586
+ else-12554
+ r-12289
+ w-12290
+ mod-12292)))
+ tmp-12548)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-12053)))))))
- (global-extend-6547
+ e-12288)))))))
+ (global-extend-4548
'core
'with-fluids
- (lambda (e-12694 r-12695 w-12696 s-12697 mod-12698)
- (let ((tmp-12700
+ (lambda (e-12993 r-12994 w-12995 s-12996 mod-12997)
+ (let ((tmp-12999
($sc-dispatch
- e-12694
+ e-12993
'(_ #(each (any any)) any . each-any))))
- (if tmp-12700
+ (if tmp-12999
(@apply
- (lambda (fluid-12704 val-12705 b-12706 b*-12707)
- (build-dynlet-6518
- s-12697
- (map (lambda (x-12788)
- (expand-6585 x-12788 r-12695 w-12696 mod-12698))
- fluid-12704)
- (map (lambda (x-12858)
- (expand-6585 x-12858 r-12695 w-12696 mod-12698))
- val-12705)
- (expand-body-6589
- (cons b-12706 b*-12707)
- (wrap-6578
- (begin
- (if (if (pair? e-12694) s-12697 #f)
- (set-source-properties! e-12694 s-12697))
- e-12694)
- w-12696
- mod-12698)
- r-12695
- w-12696
- mod-12698)))
- tmp-12700)
+ (lambda (fluid-13003 val-13004 b-13005 b*-13006)
+ (build-dynlet-4519
+ s-12996
+ (map (lambda (x-13095)
+ (expand-4586 x-13095 r-12994 w-12995 mod-12997))
+ fluid-13003)
+ (map (lambda (x-13173)
+ (expand-4586 x-13173 r-12994 w-12995 mod-12997))
+ val-13004)
+ (expand-body-4590
+ (cons b-13005 b*-13006)
+ (let ((x-13262
+ (begin
+ (if (if (pair? e-12993) s-12996 #f)
+ (set-source-properties! e-12993 s-12996))
+ e-12993)))
+ (if (if (null? (car w-12995))
+ (null? (cdr w-12995))
+ #f)
+ x-13262
+ (if (if (vector? x-13262)
+ (if (= (vector-length x-13262) 4)
+ (eq? (vector-ref x-13262 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-13294 (vector-ref x-13262 1))
+ (wrap-13295
+ (let ((w2-13303 (vector-ref x-13262 2)))
+ (let ((m1-13304 (car w-12995))
+ (s1-13305 (cdr w-12995)))
+ (if (null? m1-13304)
+ (if (null? s1-13305)
+ w2-13303
+ (cons (car w2-13303)
+ (let ((m2-13320
+ (cdr w2-13303)))
+ (if (null? m2-13320)
+ s1-13305
+ (append
+ s1-13305
+ m2-13320)))))
+ (cons (let ((m2-13328
+ (car w2-13303)))
+ (if (null? m2-13328)
+ m1-13304
+ (append
+ m1-13304
+ m2-13328)))
+ (let ((m2-13336
+ (cdr w2-13303)))
+ (if (null? m2-13336)
+ s1-13305
+ (append
+ s1-13305
+ m2-13336))))))))
+ (module-13296 (vector-ref x-13262 3)))
+ (vector
+ 'syntax-object
+ expression-13294
+ wrap-13295
+ module-13296))
+ (if (null? x-13262)
+ x-13262
+ (vector
+ 'syntax-object
+ x-13262
+ w-12995
+ mod-12997)))))
+ r-12994
+ w-12995
+ mod-12997)))
+ tmp-12999)
(syntax-violation
#f
"source expression failed to match any pattern"
- e-12694)))))
+ e-12993)))))
(module-define!
(current-module)
'begin
@@ -10928,5868 +12839,2170 @@
'eval-when
'eval-when
'()))
- (global-extend-6547
+ (global-extend-4548
'core
'syntax-case
(letrec*
- ((convert-pattern-13226
- (lambda (pattern-14823 keys-14824)
+ ((convert-pattern-13636
+ (lambda (pattern-15258 keys-15259)
(letrec*
- ((cvt*-14825
- (lambda (p*-15449 n-15450 ids-15451)
- (if (not (pair? p*-15449))
- (cvt-14827 p*-15449 n-15450 ids-15451)
+ ((cvt*-15260
+ (lambda (p*-16059 n-16060 ids-16061)
+ (if (not (pair? p*-16059))
+ (cvt-15262 p*-16059 n-16060 ids-16061)
(call-with-values
(lambda ()
- (cvt*-14825 (cdr p*-15449) n-15450 ids-15451))
- (lambda (y-15454 ids-15455)
+ (cvt*-15260 (cdr p*-16059) n-16060 ids-16061))
+ (lambda (y-16064 ids-16065)
(call-with-values
(lambda ()
- (cvt-14827 (car p*-15449) n-15450 ids-15455))
- (lambda (x-15458 ids-15459)
+ (cvt-15262 (car p*-16059) n-16060 ids-16065))
+ (lambda (x-16068 ids-16069)
(values
- (cons x-15458 y-15454)
- ids-15459))))))))
- (v-reverse-14826
- (lambda (x-15460)
+ (cons x-16068 y-16064)
+ ids-16069))))))))
+ (v-reverse-15261
+ (lambda (x-16070)
(letrec*
- ((loop-15461
- (lambda (r-15541 x-15542)
- (if (not (pair? x-15542))
- (values r-15541 x-15542)
- (loop-15461
- (cons (car x-15542) r-15541)
- (cdr x-15542))))))
- (loop-15461 '() x-15460))))
- (cvt-14827
- (lambda (p-14830 n-14831 ids-14832)
- (if (if (symbol? p-14830)
+ ((loop-16071
+ (lambda (r-16172 x-16173)
+ (if (not (pair? x-16173))
+ (values r-16172 x-16173)
+ (loop-16071
+ (cons (car x-16173) r-16172)
+ (cdr x-16173))))))
+ (loop-16071 '() x-16070))))
+ (cvt-15262
+ (lambda (p-15265 n-15266 ids-15267)
+ (if (if (symbol? p-15265)
#t
- (if (if (vector? p-14830)
- (if (= (vector-length p-14830) 4)
- (eq? (vector-ref p-14830 0) 'syntax-object)
+ (if (if (vector? p-15265)
+ (if (= (vector-length p-15265) 4)
+ (eq? (vector-ref p-15265 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref p-14830 1))
+ (symbol? (vector-ref p-15265 1))
#f))
- (if (bound-id-member?-6577 p-14830 keys-14824)
- (values (vector 'free-id p-14830) ids-14832)
- (if (if (eq? (if (if (vector? p-14830)
- (if (= (vector-length p-14830) 4)
- (eq? (vector-ref p-14830 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref p-14830 1)
- p-14830)
- (if (if (= (vector-length
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-5923"
- "l-*-5924"
- "l-*-5925"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-5896"
- "l-*-5894"
- "l-*-5892"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-5890"
- "l-*-5891"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top)
- (top)
- (top)
- (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '_
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-5923"
- "l-*-5924"
- "l-*-5925"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-5896"
- "l-*-5894"
- "l-*-5892"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-5890" "l-*-5891"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568 p-14830 '(()))
- (id-var-name-6568
- '#(syntax-object
- _
- ((top)
- #(ribcage () () ())
- #(ribcage
- #(p n ids)
- #((top) (top) (top))
- #("l-*-5923"
- "l-*-5924"
- "l-*-5925"))
- #(ribcage
- (cvt v-reverse cvt*)
- ((top) (top) (top))
- ("l-*-5896"
- "l-*-5894"
- "l-*-5892"))
- #(ribcage
- #(pattern keys)
- #((top) (top))
- #("l-*-5890" "l-*-5891"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
- (values '_ ids-14832)
+ (if (bound-id-member?-4578 p-15265 keys-15259)
+ (values (vector 'free-id p-15265) ids-15267)
+ (if (free-id=?-4574
+ p-15265
+ '#(syntax-object
+ _
+ ((top)
+ #(ribcage () () ())
+ #(ribcage
+ #(p n ids)
+ #((top) (top) (top))
+ #("l-*-3927" "l-*-3928" "l-*-3929"))
+ #(ribcage
+ (cvt v-reverse cvt*)
+ ((top) (top) (top))
+ ("l-*-3900" "l-*-3898" "l-*-3896"))
+ #(ribcage
+ #(pattern keys)
+ #((top) (top))
+ #("l-*-3894" "l-*-3895"))
+ #(ribcage
+ (gen-syntax-case
+ gen-clause
+ build-dispatch-call
+ convert-pattern)
+ ((top) (top) (top) (top))
+ ("l-*-3890"
+ "l-*-3888"
+ "l-*-3886"
+ "l-*-3884"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
+ (values '_ ids-15267)
(values
'any
- (cons (cons p-14830 n-14831) ids-14832))))
- (let ((tmp-15152 ($sc-dispatch p-14830 '(any any))))
- (if (if tmp-15152
+ (cons (cons p-15265 n-15266) ids-15267))))
+ (let ((tmp-15399 ($sc-dispatch p-15265 '(any any))))
+ (if (if tmp-15399
(@apply
- (lambda (x-15156 dots-15157)
- (if (if (if (vector? dots-15157)
- (if (= (vector-length dots-15157)
+ (lambda (x-15403 dots-15404)
+ (if (if (if (vector? dots-15404)
+ (if (= (vector-length dots-15404)
4)
- (eq? (vector-ref dots-15157 0)
+ (eq? (vector-ref dots-15404 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref dots-15157 1))
+ (symbol? (vector-ref dots-15404 1))
#f)
- (if (eq? (if (if (vector? dots-15157)
- (if (= (vector-length
- dots-15157)
- 4)
- (eq? (vector-ref
- dots-15157
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref dots-15157 1)
- dots-15157)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568
- dots-15157
- '(()))
- (id-var-name-6568
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
+ (free-id=?-4574
+ dots-15404
+ '#(syntax-object
+ ...
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(x)
+ #((top))
+ #("l-*-2416"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
#f))
- tmp-15152)
+ tmp-15399)
#f)
(@apply
- (lambda (x-15257 dots-15258)
+ (lambda (x-15443 dots-15444)
(call-with-values
(lambda ()
- (cvt-14827
- x-15257
- (#{1+}# n-14831)
- ids-14832))
- (lambda (p-15259 ids-15260)
+ (cvt-15262
+ x-15443
+ (#{1+}# n-15266)
+ ids-15267))
+ (lambda (p-15445 ids-15446)
(values
- (if (eq? p-15259 'any)
+ (if (eq? p-15445 'any)
'each-any
- (vector 'each p-15259))
- ids-15260))))
- tmp-15152)
- (let ((tmp-15261
- ($sc-dispatch p-14830 '(any any . any))))
- (if (if tmp-15261
+ (vector 'each p-15445))
+ ids-15446))))
+ tmp-15399)
+ (let ((tmp-15447
+ ($sc-dispatch p-15265 '(any any . any))))
+ (if (if tmp-15447
(@apply
- (lambda (x-15265 dots-15266 ys-15267)
- (if (if (if (vector? dots-15266)
+ (lambda (x-15451 dots-15452 ys-15453)
+ (if (if (if (vector? dots-15452)
(if (= (vector-length
- dots-15266)
+ dots-15452)
4)
(eq? (vector-ref
- dots-15266
+ dots-15452
0)
'syntax-object)
#f)
#f)
(symbol?
- (vector-ref dots-15266 1))
+ (vector-ref dots-15452 1))
#f)
- (if (eq? (if (if (vector? dots-15266)
- (if (= (vector-length
- dots-15266)
- 4)
- (eq? (vector-ref
- dots-15266
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref dots-15266 1)
- dots-15266)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568
- dots-15266
- '(()))
- (id-var-name-6568
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
+ (free-id=?-4574
+ dots-15452
+ '#(syntax-object
+ ...
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(x)
+ #((top))
+ #("l-*-2416"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
#f))
- tmp-15261)
+ tmp-15447)
#f)
(@apply
- (lambda (x-15367 dots-15368 ys-15369)
+ (lambda (x-15492 dots-15493 ys-15494)
(call-with-values
(lambda ()
- (cvt*-14825
- ys-15369
- n-14831
- ids-14832))
- (lambda (ys-15372 ids-15373)
+ (cvt*-15260
+ ys-15494
+ n-15266
+ ids-15267))
+ (lambda (ys-15979 ids-15980)
(call-with-values
(lambda ()
- (cvt-14827
- x-15367
- (#{1+}# n-14831)
- ids-15373))
- (lambda (x-15374 ids-15375)
+ (cvt-15262
+ x-15492
+ (#{1+}# n-15266)
+ ids-15980))
+ (lambda (x-15981 ids-15982)
(call-with-values
(lambda ()
- (v-reverse-14826 ys-15372))
- (lambda (ys-15408 e-15409)
+ (v-reverse-15261 ys-15979))
+ (lambda (ys-16018 e-16019)
(values
(vector
'each+
- x-15374
- ys-15408
- e-15409)
- ids-15375))))))))
- tmp-15261)
- (let ((tmp-15410
- ($sc-dispatch p-14830 '(any . any))))
- (if tmp-15410
+ x-15981
+ ys-16018
+ e-16019)
+ ids-15982))))))))
+ tmp-15447)
+ (let ((tmp-16020
+ ($sc-dispatch p-15265 '(any . any))))
+ (if tmp-16020
(@apply
- (lambda (x-15414 y-15415)
+ (lambda (x-16024 y-16025)
(call-with-values
(lambda ()
- (cvt-14827
- y-15415
- n-14831
- ids-14832))
- (lambda (y-15416 ids-15417)
+ (cvt-15262
+ y-16025
+ n-15266
+ ids-15267))
+ (lambda (y-16026 ids-16027)
(call-with-values
(lambda ()
- (cvt-14827
- x-15414
- n-14831
- ids-15417))
- (lambda (x-15418 ids-15419)
+ (cvt-15262
+ x-16024
+ n-15266
+ ids-16027))
+ (lambda (x-16028 ids-16029)
(values
- (cons x-15418 y-15416)
- ids-15419))))))
- tmp-15410)
- (let ((tmp-15420
- ($sc-dispatch p-14830 '())))
- (if tmp-15420
+ (cons x-16028 y-16026)
+ ids-16029))))))
+ tmp-16020)
+ (let ((tmp-16030
+ ($sc-dispatch p-15265 '())))
+ (if tmp-16030
(@apply
- (lambda () (values '() ids-14832))
- tmp-15420)
- (let ((tmp-15424
+ (lambda () (values '() ids-15267))
+ tmp-16030)
+ (let ((tmp-16034
($sc-dispatch
- p-14830
+ p-15265
'#(vector each-any))))
- (if tmp-15424
+ (if tmp-16034
(@apply
- (lambda (x-15428)
+ (lambda (x-16038)
(call-with-values
(lambda ()
- (cvt-14827
- x-15428
- n-14831
- ids-14832))
- (lambda (p-15429 ids-15430)
+ (cvt-15262
+ x-16038
+ n-15266
+ ids-15267))
+ (lambda (p-16039 ids-16040)
(values
- (vector 'vector p-15429)
- ids-15430))))
- tmp-15424)
+ (vector 'vector p-16039)
+ ids-16040))))
+ tmp-16034)
(values
(vector
'atom
- (strip-6598 p-14830 '(())))
- ids-14832)))))))))))))))
- (cvt-14827 pattern-14823 0 '()))))
- (build-dispatch-call-13227
- (lambda (pvars-15543 exp-15544 y-15545 r-15546 mod-15547)
- (let ((ids-15548 (map car pvars-15543)))
+ (strip-4599 p-15265 '(())))
+ ids-15267)))))))))))))))
+ (cvt-15262 pattern-15258 0 '()))))
+ (build-dispatch-call-13637
+ (lambda (pvars-16174 exp-16175 y-16176 r-16177 mod-16178)
+ (let ((ids-16179 (map car pvars-16174)))
(begin
- (map cdr pvars-15543)
- (let ((labels-15550 (gen-labels-6552 ids-15548))
- (new-vars-15551 (map gen-var-6599 ids-15548)))
- (build-application-6516
+ (map cdr pvars-16174)
+ (let ((labels-16181 (gen-labels-4553 ids-16179))
+ (new-vars-16182 (map gen-var-4600 ids-16179)))
+ (build-primcall-4529
#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-6525
+ 'apply
+ (list (build-simple-lambda-4526
#f
- (map syntax->datum ids-15548)
+ (map syntax->datum ids-16179)
#f
- new-vars-15551
+ new-vars-16182
'()
- (expand-6585
- exp-15544
- (extend-env-6543
- labels-15550
- (map (lambda (var-15874 level-15875)
+ (expand-4586
+ exp-16175
+ (extend-env-4545
+ labels-16181
+ (map (lambda (var-16510 level-16511)
(cons 'syntax
- (cons var-15874 level-15875)))
- new-vars-15551
- (map cdr pvars-15543))
- r-15546)
- (make-binding-wrap-6563
- ids-15548
- labels-15550
+ (cons var-16510 level-16511)))
+ new-vars-16182
+ (map cdr pvars-16174))
+ r-16177)
+ (make-binding-wrap-4564
+ ids-16179
+ labels-16181
'(()))
- mod-15547))
- y-15545)))))))
- (gen-clause-13228
- (lambda (x-14195
- keys-14196
- clauses-14197
- r-14198
- pat-14199
- fender-14200
- exp-14201
- mod-14202)
+ mod-16178))
+ y-16176)))))))
+ (gen-clause-13638
+ (lambda (x-14842
+ keys-14843
+ clauses-14844
+ r-14845
+ pat-14846
+ fender-14847
+ exp-14848
+ mod-14849)
(call-with-values
(lambda ()
- (convert-pattern-13226 pat-14199 keys-14196))
- (lambda (p-14357 pvars-14358)
- (if (not (distinct-bound-ids?-6576 (map car pvars-14358)))
+ (convert-pattern-13636 pat-14846 keys-14843))
+ (lambda (p-14987 pvars-14988)
+ (if (not (distinct-bound-ids?-4577 (map car pvars-14988)))
(syntax-violation
'syntax-case
"duplicate pattern variable"
- pat-14199)
+ pat-14846)
(if (not (and-map
- (lambda (x-14474)
- (not (let ((x-14478 (car x-14474)))
- (if (if (if (vector? x-14478)
+ (lambda (x-15097)
+ (not (let ((x-15101 (car x-15097)))
+ (if (if (if (vector? x-15101)
(if (= (vector-length
- x-14478)
+ x-15101)
4)
(eq? (vector-ref
- x-14478
+ x-15101
0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-14478 1))
+ (symbol? (vector-ref x-15101 1))
#f)
- (if (eq? (if (if (vector? x-14478)
- (if (= (vector-length
- x-14478)
- 4)
- (eq? (vector-ref
- x-14478
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-14478 1)
- x-14478)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568
- x-14478
- '(()))
- (id-var-name-6568
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
+ (free-id=?-4574
+ x-15101
+ '#(syntax-object
+ ...
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(x)
+ #((top))
+ #("l-*-2416"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
#f))))
- pvars-14358))
+ pvars-14988))
(syntax-violation
'syntax-case
"misplaced ellipsis"
- pat-14199)
- (let ((y-14554
+ pat-14846)
+ (let ((y-15126
(gensym
(string-append (symbol->string 'tmp) "-"))))
- (build-application-6516
- #f
- (let ((req-14697 (list 'tmp))
- (vars-14699 (list y-14554))
- (exp-14701
- (let ((y-14718
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- 'tmp
- y-14554)))
- (let ((test-exp-14722
- (let ((tmp-14731
- ($sc-dispatch
- fender-14200
- '#(atom #t))))
- (if tmp-14731
- (@apply
- (lambda () y-14718)
- tmp-14731)
- (let ((then-exp-14749
- (build-dispatch-call-13227
- pvars-14358
- fender-14200
- y-14718
- r-14198
- mod-14202))
- (else-exp-14750
+ (let ((fun-exp-15131
+ (let ((req-15140 (list 'tmp))
+ (vars-15142 (list y-15126))
+ (exp-15144
+ (let ((y-15173
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 3)
+ #f
+ 'tmp
+ y-15126)))
+ (let ((test-exp-15177
+ (let ((tmp-15186
+ ($sc-dispatch
+ fender-14847
+ '#(atom #t))))
+ (if tmp-15186
+ (@apply
+ (lambda () y-15173)
+ tmp-15186)
+ (let ((then-exp-15204
+ (build-dispatch-call-13637
+ pvars-14988
+ fender-14847
+ y-15173
+ r-14845
+ mod-14849))
+ (else-exp-15205
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 1)
+ #f
+ #f)))
(make-struct/no-tail
(vector-ref
%expanded-vtables
- 1)
+ 10)
#f
- #f)))
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 10)
- #f
- y-14718
- then-exp-14749
- else-exp-14750)))))
- (then-exp-14723
- (build-dispatch-call-13227
- pvars-14358
- exp-14201
- y-14718
- r-14198
- mod-14202))
- (else-exp-14724
- (gen-syntax-case-13229
- x-14195
- keys-14196
- clauses-14197
- r-14198
- mod-14202)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 10)
- #f
- test-exp-14722
- then-exp-14723
- else-exp-14724)))))
- (let ((body-14706
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- req-14697
- #f
- #f
- #f
- '()
- vars-14699
- exp-14701
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- #f
- '()
- body-14706)))
- (list (if (eq? p-14357 'any)
- (let ((fun-exp-14772
- (if (equal?
- (module-name (current-module))
- '(guile))
+ y-15173
+ then-exp-15204
+ else-exp-15205)))))
+ (then-exp-15178
+ (build-dispatch-call-13637
+ pvars-14988
+ exp-14848
+ y-15173
+ r-14845
+ mod-14849))
+ (else-exp-15179
+ (gen-syntax-case-13639
+ x-14842
+ keys-14843
+ clauses-14844
+ r-14845
+ mod-14849)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 7)
+ (vector-ref
+ %expanded-vtables
+ 10)
#f
- 'list)
- (make-struct/no-tail
- (vector-ref %expanded-vtables 5)
- #f
- '(guile)
- 'list
- #f)))
- (arg-exps-14773 (list x-14195)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 11)
- #f
- fun-exp-14772
- arg-exps-14773))
- (let ((fun-exp-14796
- (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-14797
- (list x-14195
- (make-struct/no-tail
- (vector-ref
- %expanded-vtables
- 1)
- #f
- p-14357))))
+ test-exp-15177
+ then-exp-15178
+ else-exp-15179)))))
+ (let ((body-15149
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 15)
+ #f
+ req-15140
+ #f
+ #f
+ #f
+ '()
+ vars-15142
+ exp-15144
+ #f)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 11)
+ (vector-ref %expanded-vtables 14)
#f
- fun-exp-14796
- arg-exps-14797))))))))))))
- (gen-syntax-case-13229
- (lambda (x-13628
- keys-13629
- clauses-13630
- r-13631
- mod-13632)
- (if (null? clauses-13630)
- (let ((fun-exp-13637
- (if (equal? (module-name (current-module)) '(guile))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 7)
- #f
- 'syntax-violation)
+ '()
+ body-15149))))
+ (arg-exps-15132
+ (list (if (eq? p-14987 'any)
+ (let ((args-15237 (list x-14842)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 12)
+ #f
+ 'list
+ args-15237))
+ (let ((args-15246
+ (list x-14842
+ (make-struct/no-tail
+ (vector-ref
+ %expanded-vtables
+ 1)
+ #f
+ p-14987))))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 12)
+ #f
+ '$sc-dispatch
+ args-15246))))))
(make-struct/no-tail
- (vector-ref %expanded-vtables 5)
+ (vector-ref %expanded-vtables 11)
#f
- '(guile)
- 'syntax-violation
- #f)))
- (arg-exps-13638
+ fun-exp-15131
+ arg-exps-15132)))))))))
+ (gen-syntax-case-13639
+ (lambda (x-14343
+ keys-14344
+ clauses-14345
+ r-14346
+ mod-14347)
+ (if (null? clauses-14345)
+ (let ((args-14353
(list (make-struct/no-tail
(vector-ref %expanded-vtables 1)
#f
@@ -16798,86 +15011,56 @@
(vector-ref %expanded-vtables 1)
#f
"source expression failed to match any pattern")
- x-13628)))
+ x-14343)))
(make-struct/no-tail
- (vector-ref %expanded-vtables 11)
+ (vector-ref %expanded-vtables 12)
#f
- fun-exp-13637
- arg-exps-13638))
- (let ((tmp-13671 (car clauses-13630)))
- (let ((tmp-13672 ($sc-dispatch tmp-13671 '(any any))))
- (if tmp-13672
+ 'syntax-violation
+ args-14353))
+ (let ((tmp-14372 (car clauses-14345)))
+ (let ((tmp-14373 ($sc-dispatch tmp-14372 '(any any))))
+ (if tmp-14373
(@apply
- (lambda (pat-13674 exp-13675)
- (if (if (if (symbol? pat-13674)
+ (lambda (pat-14375 exp-14376)
+ (if (if (if (symbol? pat-14375)
#t
- (if (if (vector? pat-13674)
- (if (= (vector-length pat-13674) 4)
- (eq? (vector-ref pat-13674 0)
+ (if (if (vector? pat-14375)
+ (if (= (vector-length pat-14375) 4)
+ (eq? (vector-ref pat-14375 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref pat-13674 1))
+ (symbol? (vector-ref pat-14375 1))
#f))
(and-map
- (lambda (x-13702)
- (not (if (eq? (if (if (vector? pat-13674)
- (if (= (vector-length
- pat-13674)
- 4)
- (eq? (vector-ref
- pat-13674
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref pat-13674 1)
- pat-13674)
- (if (if (vector? x-13702)
- (if (= (vector-length
- x-13702)
- 4)
- (eq? (vector-ref
- x-13702
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-13702 1)
- x-13702))
- (eq? (id-var-name-6568
- pat-13674
- '(()))
- (id-var-name-6568
- x-13702
- '(())))
- #f)))
+ (lambda (x-14403)
+ (not (free-id=?-4574 pat-14375 x-14403)))
(cons '#(syntax-object
...
((top)
#(ribcage
#(pat exp)
#((top) (top))
- #("l-*-6087" "l-*-6088"))
+ #("l-*-4087" "l-*-4088"))
#(ribcage () () ())
#(ribcage
#(x keys clauses r mod)
#((top) (top) (top) (top) (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
+ #("l-*-4077"
+ "l-*-4078"
+ "l-*-4079"
+ "l-*-4080"
+ "l-*-4081"))
#(ribcage
(gen-syntax-case
gen-clause
build-dispatch-call
convert-pattern)
((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
+ ("l-*-3890"
+ "l-*-3888"
+ "l-*-3886"
+ "l-*-3884"))
#(ribcage
(lambda-var-list
gen-var
@@ -16892,7 +15075,7 @@
expand-local-syntax
expand-body
expand-macro
- expand-application
+ expand-call
expand-expr
expand
syntax-type
@@ -16948,7 +15131,6 @@
id?
nonsymbol-id?
global-extend
- lookup
macros-only-env
extend-var-env
extend-env
@@ -16974,6 +15156,7 @@
build-sequence
build-data
build-primref
+ build-primcall
build-lambda-case
build-case-lambda
build-simple-lambda
@@ -16985,7 +15168,7 @@
build-lexical-reference
build-dynlet
build-conditional
- build-application
+ build-call
build-void
maybe-name-value!
decorate-source
@@ -17006,8 +15189,9 @@
make-let
make-lambda-case
make-lambda
- make-sequence
- make-application
+ make-seq
+ make-primcall
+ make-call
make-conditional
make-toplevel-define
make-toplevel-set
@@ -17158,5165 +15342,2634 @@
(top)
(top)
(top)
+ (top)
(top))
- ("l-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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-*-2098"
- "l-*-2097"
- "l-*-2096")))
+ ("l-*-47" "l-*-46" "l-*-45"))
+ #(ribcage () () ()))
(hygiene guile))
- keys-13629))
+ keys-14344))
#f)
- (if (if (eq? (if (if (= (vector-length
- '#(syntax-object
- pad
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087"
- "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x
- keys
- clauses
- r
- mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top)
- (top)
- (top)
- (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile)))
- 4)
- #t
- #f)
- 'pad
- '#(syntax-object
- pad
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087" "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile)))
- (if (if (= (vector-length
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087"
- "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x
- keys
- clauses
- r
- mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top)
- (top)
- (top)
- (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile)))
- 4)
- #t
- #f)
- '_
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087" "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568
- '#(syntax-object
- pad
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087" "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(()))
- (id-var-name-6568
- '#(syntax-object
- _
- ((top)
- #(ribcage
- #(pat exp)
- #((top) (top))
- #("l-*-6087" "l-*-6088"))
- #(ribcage () () ())
- #(ribcage
- #(x keys clauses r mod)
- #((top)
- (top)
- (top)
- (top)
- (top))
- #("l-*-6076"
- "l-*-6077"
- "l-*-6078"
- "l-*-6079"
- "l-*-6080"))
- #(ribcage
- (gen-syntax-case
- gen-clause
- build-dispatch-call
- convert-pattern)
- ((top) (top) (top) (top))
- ("l-*-5886"
- "l-*-5884"
- "l-*-5882"
- "l-*-5880"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
- (expand-6585 exp-13675 r-13631 '(()) mod-13632)
- (let ((labels-13878
+ (if (free-id=?-4574
+ '#(syntax-object
+ pad
+ ((top)
+ #(ribcage
+ #(pat exp)
+ #((top) (top))
+ #("l-*-4087" "l-*-4088"))
+ #(ribcage () () ())
+ #(ribcage
+ #(x keys clauses r mod)
+ #((top) (top) (top) (top) (top))
+ #("l-*-4077"
+ "l-*-4078"
+ "l-*-4079"
+ "l-*-4080"
+ "l-*-4081"))
+ #(ribcage
+ (gen-syntax-case
+ gen-clause
+ build-dispatch-call
+ convert-pattern)
+ ((top) (top) (top) (top))
+ ("l-*-3890"
+ "l-*-3888"
+ "l-*-3886"
+ "l-*-3884"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile))
+ '#(syntax-object
+ _
+ ((top)
+ #(ribcage
+ #(pat exp)
+ #((top) (top))
+ #("l-*-4087" "l-*-4088"))
+ #(ribcage () () ())
+ #(ribcage
+ #(x keys clauses r mod)
+ #((top) (top) (top) (top) (top))
+ #("l-*-4077"
+ "l-*-4078"
+ "l-*-4079"
+ "l-*-4080"
+ "l-*-4081"))
+ #(ribcage
+ (gen-syntax-case
+ gen-clause
+ build-dispatch-call
+ convert-pattern)
+ ((top) (top) (top) (top))
+ ("l-*-3890"
+ "l-*-3888"
+ "l-*-3886"
+ "l-*-3884"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
+ (expand-4586 exp-14376 r-14346 '(()) mod-14347)
+ (let ((labels-14485
(list (string-append
"l-"
- (session-id-6510)
+ (session-id-4511)
(symbol->string (gensym "-")))))
- (var-13879
- (let ((id-13917
- (if (if (vector? pat-13674)
+ (var-14486
+ (let ((id-14524
+ (if (if (vector? pat-14375)
(if (= (vector-length
- pat-13674)
+ pat-14375)
4)
(eq? (vector-ref
- pat-13674
+ pat-14375
0)
'syntax-object)
#f)
#f)
- (vector-ref pat-13674 1)
- pat-13674)))
+ (vector-ref pat-14375 1)
+ pat-14375)))
(gensym
(string-append
- (symbol->string id-13917)
+ (symbol->string id-14524)
"-")))))
- (build-application-6516
+ (build-call-4517
#f
- (build-simple-lambda-6525
+ (build-simple-lambda-4526
#f
- (list (syntax->datum pat-13674))
+ (list (syntax->datum pat-14375))
#f
- (list var-13879)
+ (list var-14486)
'()
- (expand-6585
- exp-13675
- (extend-env-6543
- labels-13878
+ (expand-4586
+ exp-14376
+ (extend-env-4545
+ labels-14485
(list (cons 'syntax
- (cons var-13879 0)))
- r-13631)
- (make-binding-wrap-6563
- (list pat-13674)
- labels-13878
+ (cons var-14486 0)))
+ r-14346)
+ (make-binding-wrap-4564
+ (list pat-14375)
+ labels-14485
'(()))
- mod-13632))
- (list x-13628))))
- (gen-clause-13228
- x-13628
- keys-13629
- (cdr clauses-13630)
- r-13631
- pat-13674
+ mod-14347))
+ (list x-14343))))
+ (gen-clause-13638
+ x-14343
+ keys-14344
+ (cdr clauses-14345)
+ r-14346
+ pat-14375
#t
- exp-13675
- mod-13632)))
- tmp-13672)
- (let ((tmp-14187
- ($sc-dispatch tmp-13671 '(any any any))))
- (if tmp-14187
+ exp-14376
+ mod-14347)))
+ tmp-14373)
+ (let ((tmp-14834
+ ($sc-dispatch tmp-14372 '(any any any))))
+ (if tmp-14834
(@apply
- (lambda (pat-14189 fender-14190 exp-14191)
- (gen-clause-13228
- x-13628
- keys-13629
- (cdr clauses-13630)
- r-13631
- pat-14189
- fender-14190
- exp-14191
- mod-13632))
- tmp-14187)
+ (lambda (pat-14836 fender-14837 exp-14838)
+ (gen-clause-13638
+ x-14343
+ keys-14344
+ (cdr clauses-14345)
+ r-14346
+ pat-14836
+ fender-14837
+ exp-14838
+ mod-14347))
+ tmp-14834)
(syntax-violation
'syntax-case
"invalid clause"
- (car clauses-13630)))))))))))
- (lambda (e-13230 r-13231 w-13232 s-13233 mod-13234)
- (let ((e-13235
- (wrap-6578
- (begin
- (if (if (pair? e-13230) s-13233 #f)
- (set-source-properties! e-13230 s-13233))
- e-13230)
- w-13232
- mod-13234)))
- (let ((tmp-13237
- ($sc-dispatch
- e-13235
- '(_ any each-any . each-any))))
- (if tmp-13237
- (@apply
- (lambda (val-13262 key-13263 m-13264)
- (if (and-map
- (lambda (x-13265)
- (if (if (symbol? x-13265)
- #t
- (if (if (vector? x-13265)
- (if (= (vector-length x-13265) 4)
- (eq? (vector-ref x-13265 0)
- 'syntax-object)
+ (car clauses-14345)))))))))))
+ (lambda (e-13640 r-13641 w-13642 s-13643 mod-13644)
+ (let ((e-13645
+ (let ((x-14254
+ (begin
+ (if (if (pair? e-13640) s-13643 #f)
+ (set-source-properties! e-13640 s-13643))
+ e-13640)))
+ (if (if (null? (car w-13642))
+ (null? (cdr w-13642))
+ #f)
+ x-14254
+ (if (if (vector? x-14254)
+ (if (= (vector-length x-14254) 4)
+ (eq? (vector-ref x-14254 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-14286 (vector-ref x-14254 1))
+ (wrap-14287
+ (let ((w2-14295 (vector-ref x-14254 2)))
+ (let ((m1-14296 (car w-13642))
+ (s1-14297 (cdr w-13642)))
+ (if (null? m1-14296)
+ (if (null? s1-14297)
+ w2-14295
+ (cons (car w2-14295)
+ (let ((m2-14312
+ (cdr w2-14295)))
+ (if (null? m2-14312)
+ s1-14297
+ (append
+ s1-14297
+ m2-14312)))))
+ (cons (let ((m2-14320 (car w2-14295)))
+ (if (null? m2-14320)
+ m1-14296
+ (append m1-14296 m2-14320)))
+ (let ((m2-14328 (cdr w2-14295)))
+ (if (null? m2-14328)
+ s1-14297
+ (append
+ s1-14297
+ m2-14328))))))))
+ (module-14288 (vector-ref x-14254 3)))
+ (vector
+ 'syntax-object
+ expression-14286
+ wrap-14287
+ module-14288))
+ (if (null? x-14254)
+ x-14254
+ (vector
+ 'syntax-object
+ x-14254
+ w-13642
+ mod-13644)))))))
+ (let ((tmp-13646 e-13645))
+ (let ((tmp-13647
+ ($sc-dispatch
+ tmp-13646
+ '(_ any each-any . each-any))))
+ (if tmp-13647
+ (@apply
+ (lambda (val-13695 key-13696 m-13697)
+ (if (and-map
+ (lambda (x-13698)
+ (if (if (symbol? x-13698)
+ #t
+ (if (if (vector? x-13698)
+ (if (= (vector-length x-13698) 4)
+ (eq? (vector-ref x-13698 0)
+ 'syntax-object)
+ #f)
#f)
- #f)
- (symbol? (vector-ref x-13265 1))
- #f))
- (not (if (if (if (vector? x-13265)
- (if (= (vector-length x-13265)
- 4)
- (eq? (vector-ref x-13265 0)
- 'syntax-object)
+ (symbol? (vector-ref x-13698 1))
+ #f))
+ (not (if (if (if (vector? x-13698)
+ (if (= (vector-length x-13698)
+ 4)
+ (eq? (vector-ref x-13698 0)
+ 'syntax-object)
+ #f)
#f)
- #f)
- (symbol? (vector-ref x-13265 1))
- #f)
- (if (eq? (if (if (vector? x-13265)
- (if (= (vector-length
- x-13265)
- 4)
- (eq? (vector-ref
- x-13265
- 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref x-13265 1)
- x-13265)
- (if (if (= (vector-length
- '#(syntax-object
- ...
- ((top)
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- ()
- ()
- ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top)
- (top)
- (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene
- guile)))
- 4)
- #t
- #f)
- '...
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))))
- (eq? (id-var-name-6568 x-13265 '(()))
- (id-var-name-6568
- '#(syntax-object
- ...
- ((top)
- #(ribcage () () ())
- #(ribcage () () ())
- #(ribcage
- #(x)
- #((top))
- #("l-*-4404"))
- #(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-*-2527"
- "l-*-2525"
- "l-*-2523"
- "l-*-2521"
- "l-*-2519"
- "l-*-2517"
- "l-*-2515"
- "l-*-2513"
- "l-*-2511"
- "l-*-2509"
- "l-*-2507"
- "l-*-2505"
- "l-*-2503"
- "l-*-2501"
- "l-*-2499"
- "l-*-2497"
- "l-*-2495"
- "l-*-2493"
- "l-*-2491"
- "l-*-2489"
- "l-*-2487"
- "l-*-2485"
- "l-*-2483"
- "l-*-2481"
- "l-*-2479"
- "l-*-2477"
- "l-*-2475"
- "l-*-2473"
- "l-*-2471"
- "l-*-2469"
- "l-*-2467"
- "l-*-2465"
- "l-*-2463"
- "l-*-2461"
- "l-*-2459"
- "l-*-2457"
- "l-*-2455"
- "l-*-2453"
- "l-*-2451"
- "l-*-2450"
- "l-*-2448"
- "l-*-2445"
- "l-*-2444"
- "l-*-2443"
- "l-*-2441"
- "l-*-2440"
- "l-*-2438"
- "l-*-2436"
- "l-*-2434"
- "l-*-2432"
- "l-*-2430"
- "l-*-2428"
- "l-*-2426"
- "l-*-2424"
- "l-*-2421"
- "l-*-2419"
- "l-*-2418"
- "l-*-2416"
- "l-*-2414"
- "l-*-2412"
- "l-*-2410"
- "l-*-2409"
- "l-*-2408"
- "l-*-2407"
- "l-*-2405"
- "l-*-2404"
- "l-*-2401"
- "l-*-2399"
- "l-*-2397"
- "l-*-2395"
- "l-*-2393"
- "l-*-2391"
- "l-*-2389"
- "l-*-2388"
- "l-*-2387"
- "l-*-2385"
- "l-*-2383"
- "l-*-2382"
- "l-*-2379"
- "l-*-2378"
- "l-*-2376"
- "l-*-2374"
- "l-*-2372"
- "l-*-2370"
- "l-*-2368"
- "l-*-2366"
- "l-*-2364"
- "l-*-2362"
- "l-*-2360"
- "l-*-2357"
- "l-*-2355"
- "l-*-2353"
- "l-*-2351"
- "l-*-2349"
- "l-*-2347"
- "l-*-2345"
- "l-*-2343"
- "l-*-2341"
- "l-*-2339"
- "l-*-2337"
- "l-*-2335"
- "l-*-2333"
- "l-*-2331"
- "l-*-2329"
- "l-*-2327"
- "l-*-2325"
- "l-*-2323"
- "l-*-2321"
- "l-*-2319"
- "l-*-2317"
- "l-*-2315"
- "l-*-2313"
- "l-*-2311"
- "l-*-2309"
- "l-*-2307"
- "l-*-2306"
- "l-*-2305"
- "l-*-2304"
- "l-*-2303"
- "l-*-2301"
- "l-*-2299"
- "l-*-2297"
- "l-*-2294"
- "l-*-2292"
- "l-*-2290"
- "l-*-2288"
- "l-*-2286"
- "l-*-2284"
- "l-*-2282"
- "l-*-2280"
- "l-*-2278"
- "l-*-2276"
- "l-*-2274"
- "l-*-2272"
- "l-*-2270"
- "l-*-2268"
- "l-*-2266"
- "l-*-2264"
- "l-*-2262"
- "l-*-2260"))
- #(ribcage
- (define-structure
- define-expansion-accessors
- define-expansion-constructors)
- ((top) (top) (top))
- ("l-*-2098"
- "l-*-2097"
- "l-*-2096")))
- (hygiene guile))
- '(())))
- #f)
- #f))
- #f))
- key-13263)
- (let ((x-13391
- (gensym
- (string-append (symbol->string 'tmp) "-"))))
- (build-application-6516
- s-13233
- (let ((req-13521 (list 'tmp))
- (vars-13523 (list x-13391))
- (exp-13525
- (gen-syntax-case-13229
- (make-struct/no-tail
- (vector-ref %expanded-vtables 3)
- #f
- 'tmp
- x-13391)
- key-13263
- m-13264
- r-13231
- mod-13234)))
- (let ((body-13530
- (make-struct/no-tail
- (vector-ref %expanded-vtables 14)
- #f
- req-13521
- #f
- #f
- #f
- '()
- vars-13523
- exp-13525
- #f)))
- (make-struct/no-tail
- (vector-ref %expanded-vtables 13)
- #f
- '()
- body-13530)))
- (list (expand-6585
- val-13262
- r-13231
- '(())
- mod-13234))))
- (syntax-violation
- 'syntax-case
- "invalid literals list"
- e-13235)))
- tmp-13237)
- (syntax-violation
- #f
- "source expression failed to match any pattern"
- e-13235)))))))
+ (symbol? (vector-ref x-13698 1))
+ #f)
+ (free-id=?-4574
+ x-13698
+ '#(syntax-object
+ ...
+ ((top)
+ #(ribcage () () ())
+ #(ribcage () () ())
+ #(ribcage
+ #(x)
+ #((top))
+ #("l-*-2416"))
+ #(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-call
+ 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
+ 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-primcall
+ 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-call
+ 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-seq
+ make-primcall
+ make-call
+ 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)
+ (top))
+ ("l-*-478"
+ "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-*-401"
+ "l-*-399"
+ "l-*-396"
+ "l-*-395"
+ "l-*-394"
+ "l-*-392"
+ "l-*-391"
+ "l-*-389"
+ "l-*-387"
+ "l-*-385"
+ "l-*-383"
+ "l-*-381"
+ "l-*-379"
+ "l-*-377"
+ "l-*-375"
+ "l-*-372"
+ "l-*-370"
+ "l-*-369"
+ "l-*-367"
+ "l-*-365"
+ "l-*-363"
+ "l-*-361"
+ "l-*-360"
+ "l-*-359"
+ "l-*-358"
+ "l-*-356"
+ "l-*-355"
+ "l-*-352"
+ "l-*-350"
+ "l-*-348"
+ "l-*-346"
+ "l-*-344"
+ "l-*-342"
+ "l-*-341"
+ "l-*-340"
+ "l-*-338"
+ "l-*-336"
+ "l-*-335"
+ "l-*-332"
+ "l-*-331"
+ "l-*-329"
+ "l-*-327"
+ "l-*-325"
+ "l-*-323"
+ "l-*-321"
+ "l-*-319"
+ "l-*-317"
+ "l-*-315"
+ "l-*-313"
+ "l-*-310"
+ "l-*-308"
+ "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-*-257"
+ "l-*-256"
+ "l-*-255"
+ "l-*-254"
+ "l-*-252"
+ "l-*-250"
+ "l-*-248"
+ "l-*-245"
+ "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"))
+ #(ribcage () () ()))
+ (hygiene guile)))
+ #f))
+ #f))
+ key-13696)
+ (let ((x-13763
+ (gensym
+ (string-append
+ (symbol->string 'tmp)
+ "-"))))
+ (build-call-4517
+ s-13643
+ (let ((req-13901 (list 'tmp))
+ (vars-13903 (list x-13763))
+ (exp-13905
+ (gen-syntax-case-13639
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 3)
+ #f
+ 'tmp
+ x-13763)
+ key-13696
+ m-13697
+ r-13641
+ mod-13644)))
+ (let ((body-13910
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 15)
+ #f
+ req-13901
+ #f
+ #f
+ #f
+ '()
+ vars-13903
+ exp-13905
+ #f)))
+ (make-struct/no-tail
+ (vector-ref %expanded-vtables 14)
+ #f
+ '()
+ body-13910)))
+ (list (expand-4586
+ val-13695
+ r-13641
+ '(())
+ mod-13644))))
+ (syntax-violation
+ 'syntax-case
+ "invalid literals list"
+ e-13645)))
+ tmp-13647)
+ (syntax-violation
+ #f
+ "source expression failed to match any pattern"
+ tmp-13646))))))))
(set! macroexpand
(lambda*
- (x-15948
+ (x-16590
#:optional
- (m-15949 'e)
- (esew-15950 '(eval)))
- (expand-top-sequence-6581
- (list x-15948)
+ (m-16591 'e)
+ (esew-16592 '(eval)))
+ (expand-top-sequence-4582
+ (list x-16590)
'()
'((top))
#f
- m-15949
- esew-15950
+ m-16591
+ esew-16592
(cons 'hygiene (module-name (current-module))))))
(set! identifier?
- (lambda (x-15953)
- (if (if (vector? x-15953)
- (if (= (vector-length x-15953) 4)
- (eq? (vector-ref x-15953 0) 'syntax-object)
+ (lambda (x-16595)
+ (if (if (vector? x-16595)
+ (if (= (vector-length x-16595) 4)
+ (eq? (vector-ref x-16595 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-15953 1))
+ (symbol? (vector-ref x-16595 1))
#f)))
(set! datum->syntax
- (lambda (id-15978 datum-15979)
- (let ((wrap-15984 (vector-ref id-15978 2))
- (module-15985 (vector-ref id-15978 3)))
+ (lambda (id-16620 datum-16621)
+ (let ((wrap-16626 (vector-ref id-16620 2))
+ (module-16627 (vector-ref id-16620 3)))
(vector
'syntax-object
- datum-15979
- wrap-15984
- module-15985))))
+ datum-16621
+ wrap-16626
+ module-16627))))
(set! syntax->datum
- (lambda (x-15992) (strip-6598 x-15992 '(()))))
+ (lambda (x-16634) (strip-4599 x-16634 '(()))))
(set! syntax-source
- (lambda (x-15995)
- (source-annotation-6542 x-15995)))
+ (lambda (x-16637)
+ (source-annotation-4544 x-16637)))
(set! generate-temporaries
- (lambda (ls-16148)
+ (lambda (ls-16821)
(begin
- (if (not (list? ls-16148))
+ (if (not (list? ls-16821))
(syntax-violation
'generate-temporaries
"invalid argument"
- ls-16148))
- (let ((mod-16156
+ ls-16821))
+ (let ((mod-16829
(cons 'hygiene (module-name (current-module)))))
- (map (lambda (x-16157)
- (wrap-6578 (gensym "t-") '((top)) mod-16156))
- ls-16148)))))
+ (map (lambda (x-16830)
+ (let ((x-16834 (gensym "t-")))
+ (if (if (vector? x-16834)
+ (if (= (vector-length x-16834) 4)
+ (eq? (vector-ref x-16834 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-16849 (vector-ref x-16834 1))
+ (wrap-16850
+ (let ((w2-16858 (vector-ref x-16834 2)))
+ (cons (let ((m2-16865 (car w2-16858)))
+ (if (null? m2-16865)
+ '(top)
+ (append '(top) m2-16865)))
+ (let ((m2-16872 (cdr w2-16858)))
+ (if (null? m2-16872)
+ '()
+ (append '() m2-16872))))))
+ (module-16851 (vector-ref x-16834 3)))
+ (vector
+ 'syntax-object
+ expression-16849
+ wrap-16850
+ module-16851))
+ (if (null? x-16834)
+ x-16834
+ (vector
+ 'syntax-object
+ x-16834
+ '((top))
+ mod-16829)))))
+ ls-16821)))))
(set! free-identifier=?
- (lambda (x-16161 y-16162)
+ (lambda (x-16881 y-16882)
(begin
- (if (not (if (if (vector? x-16161)
- (if (= (vector-length x-16161) 4)
- (eq? (vector-ref x-16161 0) 'syntax-object)
+ (if (not (if (if (vector? x-16881)
+ (if (= (vector-length x-16881) 4)
+ (eq? (vector-ref x-16881 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16161 1))
+ (symbol? (vector-ref x-16881 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- x-16161))
- (if (not (if (if (vector? y-16162)
- (if (= (vector-length y-16162) 4)
- (eq? (vector-ref y-16162 0) 'syntax-object)
+ x-16881))
+ (if (not (if (if (vector? y-16882)
+ (if (= (vector-length y-16882) 4)
+ (eq? (vector-ref y-16882 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-16162 1))
+ (symbol? (vector-ref y-16882 1))
#f))
(syntax-violation
'free-identifier=?
"invalid argument"
- y-16162))
- (if (eq? (if (if (vector? x-16161)
- (if (= (vector-length x-16161) 4)
- (eq? (vector-ref x-16161 0) 'syntax-object)
- #f)
- #f)
- (vector-ref x-16161 1)
- x-16161)
- (if (if (vector? y-16162)
- (if (= (vector-length y-16162) 4)
- (eq? (vector-ref y-16162 0) 'syntax-object)
- #f)
- #f)
- (vector-ref y-16162 1)
- y-16162))
- (eq? (id-var-name-6568 x-16161 '(()))
- (id-var-name-6568 y-16162 '(())))
- #f))))
+ y-16882))
+ (free-id=?-4574 x-16881 y-16882))))
(set! bound-identifier=?
- (lambda (x-16312 y-16313)
+ (lambda (x-16957 y-16958)
(begin
- (if (not (if (if (vector? x-16312)
- (if (= (vector-length x-16312) 4)
- (eq? (vector-ref x-16312 0) 'syntax-object)
+ (if (not (if (if (vector? x-16957)
+ (if (= (vector-length x-16957) 4)
+ (eq? (vector-ref x-16957 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref x-16312 1))
+ (symbol? (vector-ref x-16957 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- x-16312))
- (if (not (if (if (vector? y-16313)
- (if (= (vector-length y-16313) 4)
- (eq? (vector-ref y-16313 0) 'syntax-object)
+ x-16957))
+ (if (not (if (if (vector? y-16958)
+ (if (= (vector-length y-16958) 4)
+ (eq? (vector-ref y-16958 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref y-16313 1))
+ (symbol? (vector-ref y-16958 1))
#f))
(syntax-violation
'bound-identifier=?
"invalid argument"
- y-16313))
- (if (if (if (vector? x-16312)
- (if (= (vector-length x-16312) 4)
- (eq? (vector-ref x-16312 0) 'syntax-object)
- #f)
- #f)
- (if (vector? y-16313)
- (if (= (vector-length y-16313) 4)
- (eq? (vector-ref y-16313 0) 'syntax-object)
- #f)
- #f)
- #f)
- (if (eq? (vector-ref x-16312 1)
- (vector-ref y-16313 1))
- (same-marks?-6567
- (car (vector-ref x-16312 2))
- (car (vector-ref y-16313 2)))
- #f)
- (eq? x-16312 y-16313)))))
+ y-16958))
+ (bound-id=?-4575 x-16957 y-16958))))
(set! syntax-violation
(lambda*
- (who-16446
- message-16447
- form-16448
+ (who-17124
+ message-17125
+ form-17126
#:optional
- (subform-16449 #f))
+ (subform-17127 #f))
(begin
- (if (not (if (not who-16446)
- (not who-16446)
- (let ((t-16467 (string? who-16446)))
- (if t-16467 t-16467 (symbol? who-16446)))))
+ (if (not (if (not who-17124)
+ (not who-17124)
+ (let ((t-17145 (string? who-17124)))
+ (if t-17145 t-17145 (symbol? who-17124)))))
(syntax-violation
'syntax-violation
"invalid argument"
- who-16446))
- (if (not (string? message-16447))
+ who-17124))
+ (if (not (string? message-17125))
(syntax-violation
'syntax-violation
"invalid argument"
- message-16447))
+ message-17125))
(throw 'syntax-error
- who-16446
- message-16447
- (source-annotation-6542
- (if form-16448 form-16448 subform-16449))
- (strip-6598 form-16448 '(()))
- (if subform-16449
- (strip-6598 subform-16449 '(()))
+ who-17124
+ message-17125
+ (source-annotation-4544
+ (if form-17126 form-17126 subform-17127))
+ (strip-4599 form-17126 '(()))
+ (if subform-17127
+ (strip-4599 subform-17127 '(()))
#f)))))
(letrec*
- ((syntax-local-binding-16671
- (lambda (id-16804)
+ ((syntax-local-binding-17377
+ (lambda (id-17517)
(begin
- (if (not (if (if (vector? id-16804)
- (if (= (vector-length id-16804) 4)
- (eq? (vector-ref id-16804 0) 'syntax-object)
+ (if (not (if (if (vector? id-17517)
+ (if (= (vector-length id-17517) 4)
+ (eq? (vector-ref id-17517 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-16804 1))
+ (symbol? (vector-ref id-17517 1))
#f))
(syntax-violation
'syntax-local-binding
"invalid argument"
- id-16804))
- ((fluid-ref transformer-environment-6571)
- (lambda (e-16844
- r-16845
- w-16846
- s-16847
- rib-16848
- mod-16849)
+ id-17517))
+ ((fluid-ref transformer-environment-4572)
+ (lambda (e-17557
+ r-17558
+ w-17559
+ s-17560
+ rib-17561
+ mod-17562)
(call-with-values
(lambda ()
- (let ((id-16852 (vector-ref id-16804 1))
- (w-16853
- (let ((w-16864 (vector-ref id-16804 2)))
- (let ((ms-16865 (car w-16864))
- (s-16866 (cdr w-16864)))
- (if (if (pair? ms-16865)
- (eq? (car ms-16865) #f)
- #f)
- (cons (cdr ms-16865)
- (if rib-16848
- (cons rib-16848 (cdr s-16866))
- (cdr s-16866)))
- (cons ms-16865
- (if rib-16848
- (cons rib-16848 s-16866)
- s-16866))))))
- (mod-16855 (vector-ref id-16804 3)))
- (let ((n-16858 (id-var-name-6568 id-16852 w-16853)))
- (if (symbol? n-16858)
- (let ((mod-16872
- (if (if (vector? id-16852)
- (if (= (vector-length id-16852) 4)
- (eq? (vector-ref id-16852 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-16852 3)
- mod-16855)))
- (let ((b-16873
- (let ((t-16874
- (get-global-definition-hook-6512
- n-16858
- mod-16872)))
- (if t-16874 t-16874 '(global)))))
- (if (eq? (car b-16873) 'global)
- (values 'global n-16858 mod-16872)
- (values
- (car b-16873)
- (cdr b-16873)
- mod-16872))))
- (if (string? n-16858)
- (let ((mod-16900
- (if (if (vector? id-16852)
- (if (= (vector-length id-16852) 4)
- (eq? (vector-ref id-16852 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref id-16852 3)
- mod-16855)))
- (let ((b-16901
- (let ((t-16902
- (assq-ref r-16845 n-16858)))
- (if t-16902
- t-16902
- '(displaced-lexical)))))
- (values
- (car b-16901)
- (cdr b-16901)
- mod-16900)))
- (error "unexpected id-var-name"
- id-16852
- w-16853
- n-16858))))))
- (lambda (type-16915 value-16916 mod-16917)
- (if (eqv? type-16915 'lexical)
- (values 'lexical value-16916)
- (if (eqv? type-16915 'macro)
- (values 'macro value-16916)
- (if (eqv? type-16915 'syntax)
- (values 'pattern-variable value-16916)
- (if (eqv? type-16915 'displaced-lexical)
+ (resolve-identifier-4571
+ (vector-ref id-17517 1)
+ (let ((w-17569 (vector-ref id-17517 2)))
+ (let ((ms-17570 (car w-17569))
+ (s-17571 (cdr w-17569)))
+ (if (if (pair? ms-17570)
+ (eq? (car ms-17570) #f)
+ #f)
+ (cons (cdr ms-17570)
+ (if rib-17561
+ (cons rib-17561 (cdr s-17571))
+ (cdr s-17571)))
+ (cons ms-17570
+ (if rib-17561
+ (cons rib-17561 s-17571)
+ s-17571)))))
+ r-17558
+ (vector-ref id-17517 3)
+ #t))
+ (lambda (type-17578 value-17579 mod-17580)
+ (if (eqv? type-17578 'lexical)
+ (values 'lexical value-17579)
+ (if (eqv? type-17578 'macro)
+ (values 'macro value-17579)
+ (if (eqv? type-17578 'syntax)
+ (values 'pattern-variable value-17579)
+ (if (eqv? type-17578 'displaced-lexical)
(values 'displaced-lexical #f)
- (if (eqv? type-16915 'global)
+ (if (eqv? type-17578 'global)
(values
'global
- (cons value-16916 (cdr mod-16917)))
+ (cons value-17579 (cdr mod-17580)))
(values 'other #f)))))))))))))
- (syntax-locally-bound-identifiers-16672
- (lambda (id-16928)
+ (syntax-locally-bound-identifiers-17378
+ (lambda (id-17591)
(begin
- (if (not (if (if (vector? id-16928)
- (if (= (vector-length id-16928) 4)
- (eq? (vector-ref id-16928 0) 'syntax-object)
+ (if (not (if (if (vector? id-17591)
+ (if (= (vector-length id-17591) 4)
+ (eq? (vector-ref id-17591 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-16928 1))
+ (symbol? (vector-ref id-17591 1))
#f))
(syntax-violation
'syntax-locally-bound-identifiers
"invalid argument"
- id-16928))
- (locally-bound-identifiers-6569
- (vector-ref id-16928 2)
- (vector-ref id-16928 3))))))
+ id-17591))
+ (locally-bound-identifiers-4570
+ (vector-ref id-17591 2)
+ (vector-ref id-17591 3))))))
(begin
(define!
'syntax-module
- (lambda (id-16674)
+ (lambda (id-17380)
(begin
- (if (not (if (if (vector? id-16674)
- (if (= (vector-length id-16674) 4)
- (eq? (vector-ref id-16674 0) 'syntax-object)
+ (if (not (if (if (vector? id-17380)
+ (if (= (vector-length id-17380) 4)
+ (eq? (vector-ref id-17380 0) 'syntax-object)
#f)
#f)
- (symbol? (vector-ref id-16674 1))
+ (symbol? (vector-ref id-17380 1))
#f))
(syntax-violation
'syntax-module
"invalid argument"
- id-16674))
- (cdr (vector-ref id-16674 3)))))
+ id-17380))
+ (cdr (vector-ref id-17380 3)))))
(define!
'syntax-local-binding
- syntax-local-binding-16671)
+ syntax-local-binding-17377)
(define!
'syntax-locally-bound-identifiers
- syntax-locally-bound-identifiers-16672)))
+ syntax-locally-bound-identifiers-17378)))
(letrec*
- ((match-each-17035
- (lambda (e-17622 p-17623 w-17624 mod-17625)
- (if (pair? e-17622)
- (let ((first-17626
- (match-17041
- (car e-17622)
- p-17623
- w-17624
+ ((match-each-17708
+ (lambda (e-18587 p-18588 w-18589 mod-18590)
+ (if (pair? e-18587)
+ (let ((first-18591
+ (match-17714
+ (car e-18587)
+ p-18588
+ w-18589
'()
- mod-17625)))
- (if first-17626
- (let ((rest-17629
- (match-each-17035
- (cdr e-17622)
- p-17623
- w-17624
- mod-17625)))
- (if rest-17629 (cons first-17626 rest-17629) #f))
+ mod-18590)))
+ (if first-18591
+ (let ((rest-18594
+ (match-each-17708
+ (cdr e-18587)
+ p-18588
+ w-18589
+ mod-18590)))
+ (if rest-18594 (cons first-18591 rest-18594) #f))
#f))
- (if (null? e-17622)
+ (if (null? e-18587)
'()
- (if (if (vector? e-17622)
- (if (= (vector-length e-17622) 4)
- (eq? (vector-ref e-17622 0) 'syntax-object)
+ (if (if (vector? e-18587)
+ (if (= (vector-length e-18587) 4)
+ (eq? (vector-ref e-18587 0) 'syntax-object)
#f)
#f)
- (match-each-17035
- (vector-ref e-17622 1)
- p-17623
- (join-wraps-6565 w-17624 (vector-ref e-17622 2))
- (vector-ref e-17622 3))
+ (match-each-17708
+ (vector-ref e-18587 1)
+ p-18588
+ (let ((w2-18616 (vector-ref e-18587 2)))
+ (let ((m1-18617 (car w-18589))
+ (s1-18618 (cdr w-18589)))
+ (if (null? m1-18617)
+ (if (null? s1-18618)
+ w2-18616
+ (cons (car w2-18616)
+ (let ((m2-18629 (cdr w2-18616)))
+ (if (null? m2-18629)
+ s1-18618
+ (append s1-18618 m2-18629)))))
+ (cons (let ((m2-18637 (car w2-18616)))
+ (if (null? m2-18637)
+ m1-18617
+ (append m1-18617 m2-18637)))
+ (let ((m2-18645 (cdr w2-18616)))
+ (if (null? m2-18645)
+ s1-18618
+ (append s1-18618 m2-18645)))))))
+ (vector-ref e-18587 3))
#f)))))
- (match-each-any-17037
- (lambda (e-17657 w-17658 mod-17659)
- (if (pair? e-17657)
- (let ((l-17660
- (match-each-any-17037
- (cdr e-17657)
- w-17658
- mod-17659)))
- (if l-17660
- (cons (wrap-6578 (car e-17657) w-17658 mod-17659)
- l-17660)
+ (match-each-any-17710
+ (lambda (e-18654 w-18655 mod-18656)
+ (if (pair? e-18654)
+ (let ((l-18657
+ (match-each-any-17710
+ (cdr e-18654)
+ w-18655
+ mod-18656)))
+ (if l-18657
+ (cons (let ((x-18662 (car e-18654)))
+ (if (if (null? (car w-18655))
+ (null? (cdr w-18655))
+ #f)
+ x-18662
+ (if (if (vector? x-18662)
+ (if (= (vector-length x-18662) 4)
+ (eq? (vector-ref x-18662 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-18680 (vector-ref x-18662 1))
+ (wrap-18681
+ (let ((w2-18689 (vector-ref x-18662 2)))
+ (let ((m1-18690 (car w-18655))
+ (s1-18691 (cdr w-18655)))
+ (if (null? m1-18690)
+ (if (null? s1-18691)
+ w2-18689
+ (cons (car w2-18689)
+ (let ((m2-18706
+ (cdr w2-18689)))
+ (if (null? m2-18706)
+ s1-18691
+ (append
+ s1-18691
+ m2-18706)))))
+ (cons (let ((m2-18714
+ (car w2-18689)))
+ (if (null? m2-18714)
+ m1-18690
+ (append
+ m1-18690
+ m2-18714)))
+ (let ((m2-18722
+ (cdr w2-18689)))
+ (if (null? m2-18722)
+ s1-18691
+ (append
+ s1-18691
+ m2-18722))))))))
+ (module-18682 (vector-ref x-18662 3)))
+ (vector
+ 'syntax-object
+ expression-18680
+ wrap-18681
+ module-18682))
+ (if (null? x-18662)
+ x-18662
+ (vector
+ 'syntax-object
+ x-18662
+ w-18655
+ mod-18656)))))
+ l-18657)
#f))
- (if (null? e-17657)
+ (if (null? e-18654)
'()
- (if (if (vector? e-17657)
- (if (= (vector-length e-17657) 4)
- (eq? (vector-ref e-17657 0) 'syntax-object)
+ (if (if (vector? e-18654)
+ (if (= (vector-length e-18654) 4)
+ (eq? (vector-ref e-18654 0) 'syntax-object)
#f)
#f)
- (match-each-any-17037
- (vector-ref e-17657 1)
- (join-wraps-6565 w-17658 (vector-ref e-17657 2))
- mod-17659)
+ (match-each-any-17710
+ (vector-ref e-18654 1)
+ (let ((w2-18755 (vector-ref e-18654 2)))
+ (let ((m1-18756 (car w-18655))
+ (s1-18757 (cdr w-18655)))
+ (if (null? m1-18756)
+ (if (null? s1-18757)
+ w2-18755
+ (cons (car w2-18755)
+ (let ((m2-18768 (cdr w2-18755)))
+ (if (null? m2-18768)
+ s1-18757
+ (append s1-18757 m2-18768)))))
+ (cons (let ((m2-18776 (car w2-18755)))
+ (if (null? m2-18776)
+ m1-18756
+ (append m1-18756 m2-18776)))
+ (let ((m2-18784 (cdr w2-18755)))
+ (if (null? m2-18784)
+ s1-18757
+ (append s1-18757 m2-18784)))))))
+ mod-18656)
#f)))))
- (match-empty-17038
- (lambda (p-17684 r-17685)
- (if (null? p-17684)
- r-17685
- (if (eq? p-17684 '_)
- r-17685
- (if (eq? p-17684 'any)
- (cons '() r-17685)
- (if (pair? p-17684)
- (match-empty-17038
- (car p-17684)
- (match-empty-17038 (cdr p-17684) r-17685))
- (if (eq? p-17684 'each-any)
- (cons '() r-17685)
- (let ((atom-key-17686 (vector-ref p-17684 0)))
- (if (eqv? atom-key-17686 'each)
- (match-empty-17038
- (vector-ref p-17684 1)
- r-17685)
- (if (eqv? atom-key-17686 'each+)
- (match-empty-17038
- (vector-ref p-17684 1)
- (match-empty-17038
- (reverse (vector-ref p-17684 2))
- (match-empty-17038
- (vector-ref p-17684 3)
- r-17685)))
- (if (if (eqv? atom-key-17686 'free-id)
+ (match-empty-17711
+ (lambda (p-18789 r-18790)
+ (if (null? p-18789)
+ r-18790
+ (if (eq? p-18789 '_)
+ r-18790
+ (if (eq? p-18789 'any)
+ (cons '() r-18790)
+ (if (pair? p-18789)
+ (match-empty-17711
+ (car p-18789)
+ (match-empty-17711 (cdr p-18789) r-18790))
+ (if (eq? p-18789 'each-any)
+ (cons '() r-18790)
+ (let ((atom-key-18791 (vector-ref p-18789 0)))
+ (if (eqv? atom-key-18791 'each)
+ (match-empty-17711
+ (vector-ref p-18789 1)
+ r-18790)
+ (if (eqv? atom-key-18791 'each+)
+ (match-empty-17711
+ (vector-ref p-18789 1)
+ (match-empty-17711
+ (reverse (vector-ref p-18789 2))
+ (match-empty-17711
+ (vector-ref p-18789 3)
+ r-18790)))
+ (if (if (eqv? atom-key-18791 'free-id)
#t
- (eqv? atom-key-17686 'atom))
- r-17685
- (if (eqv? atom-key-17686 'vector)
- (match-empty-17038
- (vector-ref p-17684 1)
- r-17685)))))))))))))
- (combine-17039
- (lambda (r*-17705 r-17706)
- (if (null? (car r*-17705))
- r-17706
- (cons (map car r*-17705)
- (combine-17039 (map cdr r*-17705) r-17706)))))
- (match*-17040
- (lambda (e-17070 p-17071 w-17072 r-17073 mod-17074)
- (if (null? p-17071)
- (if (null? e-17070) r-17073 #f)
- (if (pair? p-17071)
- (if (pair? e-17070)
- (match-17041
- (car e-17070)
- (car p-17071)
- w-17072
- (match-17041
- (cdr e-17070)
- (cdr p-17071)
- w-17072
- r-17073
- mod-17074)
- mod-17074)
+ (eqv? atom-key-18791 'atom))
+ r-18790
+ (if (eqv? atom-key-18791 'vector)
+ (match-empty-17711
+ (vector-ref p-18789 1)
+ r-18790)))))))))))))
+ (combine-17712
+ (lambda (r*-18810 r-18811)
+ (if (null? (car r*-18810))
+ r-18811
+ (cons (map car r*-18810)
+ (combine-17712 (map cdr r*-18810) r-18811)))))
+ (match*-17713
+ (lambda (e-17743 p-17744 w-17745 r-17746 mod-17747)
+ (if (null? p-17744)
+ (if (null? e-17743) r-17746 #f)
+ (if (pair? p-17744)
+ (if (pair? e-17743)
+ (match-17714
+ (car e-17743)
+ (car p-17744)
+ w-17745
+ (match-17714
+ (cdr e-17743)
+ (cdr p-17744)
+ w-17745
+ r-17746
+ mod-17747)
+ mod-17747)
#f)
- (if (eq? p-17071 'each-any)
- (let ((l-17079
- (match-each-any-17037 e-17070 w-17072 mod-17074)))
- (if l-17079 (cons l-17079 r-17073) #f))
- (let ((atom-key-17084 (vector-ref p-17071 0)))
- (if (eqv? atom-key-17084 'each)
- (if (null? e-17070)
- (match-empty-17038
- (vector-ref p-17071 1)
- r-17073)
- (let ((l-17091
- (match-each-17035
- e-17070
- (vector-ref p-17071 1)
- w-17072
- mod-17074)))
- (if l-17091
+ (if (eq? p-17744 'each-any)
+ (let ((l-17752
+ (match-each-any-17710 e-17743 w-17745 mod-17747)))
+ (if l-17752 (cons l-17752 r-17746) #f))
+ (let ((atom-key-17757 (vector-ref p-17744 0)))
+ (if (eqv? atom-key-17757 'each)
+ (if (null? e-17743)
+ (match-empty-17711
+ (vector-ref p-17744 1)
+ r-17746)
+ (let ((l-17764
+ (match-each-17708
+ e-17743
+ (vector-ref p-17744 1)
+ w-17745
+ mod-17747)))
+ (if l-17764
(letrec*
- ((collect-17094
- (lambda (l-17145)
- (if (null? (car l-17145))
- r-17073
- (cons (map car l-17145)
- (collect-17094
- (map cdr l-17145)))))))
- (collect-17094 l-17091))
+ ((collect-17767
+ (lambda (l-17824)
+ (if (null? (car l-17824))
+ r-17746
+ (cons (map car l-17824)
+ (collect-17767
+ (map cdr l-17824)))))))
+ (collect-17767 l-17764))
#f)))
- (if (eqv? atom-key-17084 'each+)
+ (if (eqv? atom-key-17757 'each+)
(call-with-values
(lambda ()
- (let ((x-pat-17154 (vector-ref p-17071 1))
- (y-pat-17155 (vector-ref p-17071 2))
- (z-pat-17156 (vector-ref p-17071 3)))
+ (let ((x-pat-17833 (vector-ref p-17744 1))
+ (y-pat-17834 (vector-ref p-17744 2))
+ (z-pat-17835 (vector-ref p-17744 3)))
(letrec*
- ((f-17160
- (lambda (e-17162 w-17163)
- (if (pair? e-17162)
+ ((f-17839
+ (lambda (e-17841 w-17842)
+ (if (pair? e-17841)
(call-with-values
(lambda ()
- (f-17160 (cdr e-17162) w-17163))
- (lambda (xr*-17164
- y-pat-17165
- r-17166)
- (if r-17166
- (if (null? y-pat-17165)
- (let ((xr-17167
- (match-17041
- (car e-17162)
- x-pat-17154
- w-17163
+ (f-17839 (cdr e-17841) w-17842))
+ (lambda (xr*-17843
+ y-pat-17844
+ r-17845)
+ (if r-17845
+ (if (null? y-pat-17844)
+ (let ((xr-17846
+ (match-17714
+ (car e-17841)
+ x-pat-17833
+ w-17842
'()
- mod-17074)))
- (if xr-17167
+ mod-17747)))
+ (if xr-17846
(values
- (cons xr-17167 xr*-17164)
- y-pat-17165
- r-17166)
+ (cons xr-17846 xr*-17843)
+ y-pat-17844
+ r-17845)
(values #f #f #f)))
(values
'()
- (cdr y-pat-17165)
- (match-17041
- (car e-17162)
- (car y-pat-17165)
- w-17163
- r-17166
- mod-17074)))
+ (cdr y-pat-17844)
+ (match-17714
+ (car e-17841)
+ (car y-pat-17844)
+ w-17842
+ r-17845
+ mod-17747)))
(values #f #f #f))))
- (if (if (vector? e-17162)
- (if (= (vector-length e-17162) 4)
- (eq? (vector-ref e-17162 0)
+ (if (if (vector? e-17841)
+ (if (= (vector-length e-17841) 4)
+ (eq? (vector-ref e-17841 0)
'syntax-object)
#f)
#f)
- (f-17160
- (vector-ref e-17162 1)
- (join-wraps-6565 w-17163 e-17162))
+ (f-17839
+ (vector-ref e-17841 1)
+ (let ((m1-17872 (car w-17842))
+ (s1-17873 (cdr w-17842)))
+ (if (null? m1-17872)
+ (if (null? s1-17873)
+ e-17841
+ (cons (car e-17841)
+ (let ((m2-17885
+ (cdr e-17841)))
+ (if (null? m2-17885)
+ s1-17873
+ (append
+ s1-17873
+ m2-17885)))))
+ (cons (let ((m2-17895
+ (car e-17841)))
+ (if (null? m2-17895)
+ m1-17872
+ (append
+ m1-17872
+ m2-17895)))
+ (let ((m2-17905
+ (cdr e-17841)))
+ (if (null? m2-17905)
+ s1-17873
+ (append
+ s1-17873
+ m2-17905)))))))
(values
'()
- y-pat-17155
- (match-17041
- e-17162
- z-pat-17156
- w-17163
- r-17073
- mod-17074)))))))
- (f-17160 e-17070 w-17072))))
- (lambda (xr*-17193 y-pat-17194 r-17195)
- (if r-17195
- (if (null? y-pat-17194)
- (if (null? xr*-17193)
- (match-empty-17038
- (vector-ref p-17071 1)
- r-17195)
- (combine-17039 xr*-17193 r-17195))
+ y-pat-17834
+ (match-17714
+ e-17841
+ z-pat-17835
+ w-17842
+ r-17746
+ mod-17747)))))))
+ (f-17839 e-17743 w-17745))))
+ (lambda (xr*-17915 y-pat-17916 r-17917)
+ (if r-17917
+ (if (null? y-pat-17916)
+ (if (null? xr*-17915)
+ (match-empty-17711
+ (vector-ref p-17744 1)
+ r-17917)
+ (combine-17712 xr*-17915 r-17917))
#f)
#f)))
- (if (eqv? atom-key-17084 'free-id)
- (if (if (symbol? e-17070)
+ (if (eqv? atom-key-17757 'free-id)
+ (if (if (symbol? e-17743)
#t
- (if (if (vector? e-17070)
- (if (= (vector-length e-17070) 4)
- (eq? (vector-ref e-17070 0)
+ (if (if (vector? e-17743)
+ (if (= (vector-length e-17743) 4)
+ (eq? (vector-ref e-17743 0)
'syntax-object)
#f)
#f)
- (symbol? (vector-ref e-17070 1))
+ (symbol? (vector-ref e-17743 1))
#f))
- (if (let ((i-17526
- (wrap-6578 e-17070 w-17072 mod-17074))
- (j-17527 (vector-ref p-17071 1)))
- (if (eq? (if (if (vector? i-17526)
- (if (= (vector-length
- i-17526)
- 4)
- (eq? (vector-ref i-17526 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref i-17526 1)
- i-17526)
- (if (if (vector? j-17527)
- (if (= (vector-length
- j-17527)
- 4)
- (eq? (vector-ref j-17527 0)
- 'syntax-object)
- #f)
- #f)
- (vector-ref j-17527 1)
- j-17527))
- (eq? (id-var-name-6568 i-17526 '(()))
- (id-var-name-6568 j-17527 '(())))
- #f))
- r-17073
+ (if (free-id=?-4574
+ (if (if (null? (car w-17745))
+ (null? (cdr w-17745))
+ #f)
+ e-17743
+ (if (if (vector? e-17743)
+ (if (= (vector-length e-17743) 4)
+ (eq? (vector-ref e-17743 0)
+ 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-18345
+ (vector-ref e-17743 1))
+ (wrap-18346
+ (let ((w2-18356
+ (vector-ref e-17743 2)))
+ (let ((m1-18357 (car w-17745))
+ (s1-18358
+ (cdr w-17745)))
+ (if (null? m1-18357)
+ (if (null? s1-18358)
+ w2-18356
+ (cons (car w2-18356)
+ (let ((m2-18375
+ (cdr w2-18356)))
+ (if (null? m2-18375)
+ s1-18358
+ (append
+ s1-18358
+ m2-18375)))))
+ (cons (let ((m2-18383
+ (car w2-18356)))
+ (if (null? m2-18383)
+ m1-18357
+ (append
+ m1-18357
+ m2-18383)))
+ (let ((m2-18391
+ (cdr w2-18356)))
+ (if (null? m2-18391)
+ s1-18358
+ (append
+ s1-18358
+ m2-18391))))))))
+ (module-18347
+ (vector-ref e-17743 3)))
+ (vector
+ 'syntax-object
+ expression-18345
+ wrap-18346
+ module-18347))
+ (if (null? e-17743)
+ e-17743
+ (vector
+ 'syntax-object
+ e-17743
+ w-17745
+ mod-17747))))
+ (vector-ref p-17744 1))
+ r-17746
#f)
#f)
- (if (eqv? atom-key-17084 'atom)
+ (if (eqv? atom-key-17757 'atom)
(if (equal?
- (vector-ref p-17071 1)
- (strip-6598 e-17070 w-17072))
- r-17073
+ (vector-ref p-17744 1)
+ (strip-4599 e-17743 w-17745))
+ r-17746
#f)
- (if (eqv? atom-key-17084 'vector)
- (if (vector? e-17070)
- (match-17041
- (vector->list e-17070)
- (vector-ref p-17071 1)
- w-17072
- r-17073
- mod-17074)
+ (if (eqv? atom-key-17757 'vector)
+ (if (vector? e-17743)
+ (match-17714
+ (vector->list e-17743)
+ (vector-ref p-17744 1)
+ w-17745
+ r-17746
+ mod-17747)
#f))))))))))))
- (match-17041
- (lambda (e-17587 p-17588 w-17589 r-17590 mod-17591)
- (if (not r-17590)
+ (match-17714
+ (lambda (e-18424 p-18425 w-18426 r-18427 mod-18428)
+ (if (not r-18427)
#f
- (if (eq? p-17588 '_)
- r-17590
- (if (eq? p-17588 'any)
- (cons (wrap-6578 e-17587 w-17589 mod-17591)
- r-17590)
- (if (if (vector? e-17587)
- (if (= (vector-length e-17587) 4)
- (eq? (vector-ref e-17587 0) 'syntax-object)
+ (if (eq? p-18425 '_)
+ r-18427
+ (if (eq? p-18425 'any)
+ (cons (if (if (null? (car w-18426))
+ (null? (cdr w-18426))
+ #f)
+ e-18424
+ (if (if (vector? e-18424)
+ (if (= (vector-length e-18424) 4)
+ (eq? (vector-ref e-18424 0) 'syntax-object)
+ #f)
+ #f)
+ (let ((expression-18458 (vector-ref e-18424 1))
+ (wrap-18459
+ (let ((w2-18469 (vector-ref e-18424 2)))
+ (let ((m1-18470 (car w-18426))
+ (s1-18471 (cdr w-18426)))
+ (if (null? m1-18470)
+ (if (null? s1-18471)
+ w2-18469
+ (cons (car w2-18469)
+ (let ((m2-18488
+ (cdr w2-18469)))
+ (if (null? m2-18488)
+ s1-18471
+ (append
+ s1-18471
+ m2-18488)))))
+ (cons (let ((m2-18496
+ (car w2-18469)))
+ (if (null? m2-18496)
+ m1-18470
+ (append
+ m1-18470
+ m2-18496)))
+ (let ((m2-18504
+ (cdr w2-18469)))
+ (if (null? m2-18504)
+ s1-18471
+ (append
+ s1-18471
+ m2-18504))))))))
+ (module-18460 (vector-ref e-18424 3)))
+ (vector
+ 'syntax-object
+ expression-18458
+ wrap-18459
+ module-18460))
+ (if (null? e-18424)
+ e-18424
+ (vector
+ 'syntax-object
+ e-18424
+ w-18426
+ mod-18428))))
+ r-18427)
+ (if (if (vector? e-18424)
+ (if (= (vector-length e-18424) 4)
+ (eq? (vector-ref e-18424 0) 'syntax-object)
#f)
#f)
- (match*-17040
- (vector-ref e-17587 1)
- p-17588
- (join-wraps-6565 w-17589 (vector-ref e-17587 2))
- r-17590
- (vector-ref e-17587 3))
- (match*-17040
- e-17587
- p-17588
- w-17589
- r-17590
- mod-17591))))))))
+ (match*-17713
+ (vector-ref e-18424 1)
+ p-18425
+ (let ((w2-18547 (vector-ref e-18424 2)))
+ (let ((m1-18548 (car w-18426))
+ (s1-18549 (cdr w-18426)))
+ (if (null? m1-18548)
+ (if (null? s1-18549)
+ w2-18547
+ (cons (car w2-18547)
+ (let ((m2-18560 (cdr w2-18547)))
+ (if (null? m2-18560)
+ s1-18549
+ (append s1-18549 m2-18560)))))
+ (cons (let ((m2-18568 (car w2-18547)))
+ (if (null? m2-18568)
+ m1-18548
+ (append m1-18548 m2-18568)))
+ (let ((m2-18576 (cdr w2-18547)))
+ (if (null? m2-18576)
+ s1-18549
+ (append s1-18549 m2-18576)))))))
+ r-18427
+ (vector-ref e-18424 3))
+ (match*-17713
+ e-18424
+ p-18425
+ w-18426
+ r-18427
+ mod-18428))))))))
(set! $sc-dispatch
- (lambda (e-17042 p-17043)
- (if (eq? p-17043 'any)
- (list e-17042)
- (if (eq? p-17043 '_)
+ (lambda (e-17715 p-17716)
+ (if (eq? p-17716 'any)
+ (list e-17715)
+ (if (eq? p-17716 '_)
'()
- (if (if (vector? e-17042)
- (if (= (vector-length e-17042) 4)
- (eq? (vector-ref e-17042 0) 'syntax-object)
+ (if (if (vector? e-17715)
+ (if (= (vector-length e-17715) 4)
+ (eq? (vector-ref e-17715 0) 'syntax-object)
#f)
#f)
- (match*-17040
- (vector-ref e-17042 1)
- p-17043
- (vector-ref e-17042 2)
+ (match*-17713
+ (vector-ref e-17715 1)
+ p-17716
+ (vector-ref e-17715 2)
'()
- (vector-ref e-17042 3))
- (match*-17040 e-17042 p-17043 '(()) '() #f))))))))))
+ (vector-ref e-17715 3))
+ (match*-17713 e-17715 p-17716 '(()) '() #f))))))))))
(define with-syntax
(make-syntax-transformer
'with-syntax
'macro
- (lambda (x-29889)
- (let ((tmp-29891
- ($sc-dispatch x-29889 '(_ () any . each-any))))
- (if tmp-29891
+ (lambda (x-37252)
+ (let ((tmp-37254
+ ($sc-dispatch x-37252 '(_ () any . each-any))))
+ (if tmp-37254
(@apply
- (lambda (e1-29895 e2-29896)
+ (lambda (e1-37258 e2-37259)
(cons '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-29862" "l-*-29863"))
+ #("l-*-37225" "l-*-37226"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29859")))
+ #(ribcage #(x) #((top)) #("l-*-37222"))
+ #(ribcage
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-29895 e2-29896))))
- tmp-29891)
- (let ((tmp-29897
+ (cons '() (cons e1-37258 e2-37259))))
+ tmp-37254)
+ (let ((tmp-37260
($sc-dispatch
- x-29889
+ x-37252
'(_ ((any any)) any . each-any))))
- (if tmp-29897
+ (if tmp-37260
(@apply
- (lambda (out-29901 in-29902 e1-29903 e2-29904)
+ (lambda (out-37264 in-37265 e1-37266 e2-37267)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-29868"
- "l-*-29869"
- "l-*-29870"
- "l-*-29871"))
+ #("l-*-37231"
+ "l-*-37232"
+ "l-*-37233"
+ "l-*-37234"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29859")))
+ #(ribcage #(x) #((top)) #("l-*-37222"))
+ #(ribcage
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- in-29902
+ in-37265
'()
- (list out-29901
+ (list out-37264
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-29868"
- "l-*-29869"
- "l-*-29870"
- "l-*-29871"))
+ #("l-*-37231"
+ "l-*-37232"
+ "l-*-37233"
+ "l-*-37234"))
#(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-37222"))
#(ribcage
- #(x)
- #((top))
- #("l-*-29859")))
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-29903 e2-29904))))))
- tmp-29897)
- (let ((tmp-29905
+ (cons '() (cons e1-37266 e2-37267))))))
+ tmp-37260)
+ (let ((tmp-37268
($sc-dispatch
- x-29889
+ x-37252
'(_ #(each (any any)) any . each-any))))
- (if tmp-29905
+ (if tmp-37268
(@apply
- (lambda (out-29909 in-29910 e1-29911 e2-29912)
+ (lambda (out-37272 in-37273 e1-37274 e2-37275)
(list '#(syntax-object
syntax-case
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-29878"
- "l-*-29879"
- "l-*-29880"
- "l-*-29881"))
+ #("l-*-37241"
+ "l-*-37242"
+ "l-*-37243"
+ "l-*-37244"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29859")))
+ #(ribcage #(x) #((top)) #("l-*-37222"))
+ #(ribcage
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(cons '#(syntax-object
list
@@ -22324,66 +17977,93 @@
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-29878"
- "l-*-29879"
- "l-*-29880"
- "l-*-29881"))
+ #("l-*-37241"
+ "l-*-37242"
+ "l-*-37243"
+ "l-*-37244"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29859")))
+ #(ribcage #(x) #((top)) #("l-*-37222"))
+ #(ribcage
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- in-29910)
+ in-37273)
'()
- (list out-29909
+ (list out-37272
(cons '#(syntax-object
let
((top)
#(ribcage
#(out in e1 e2)
#((top) (top) (top) (top))
- #("l-*-29878"
- "l-*-29879"
- "l-*-29880"
- "l-*-29881"))
+ #("l-*-37241"
+ "l-*-37242"
+ "l-*-37243"
+ "l-*-37244"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-29859")))
+ #("l-*-37222"))
+ #(ribcage
+ (with-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ with-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-29911 e2-29912))))))
- tmp-29905)
+ (cons '() (cons e1-37274 e2-37275))))))
+ tmp-37268)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29889))))))))))
+ x-37252))))))))))
(define syntax-rules
(make-syntax-transformer
'syntax-rules
'macro
- (lambda (x-29966)
- (let ((tmp-29968
+ (lambda (x-37330)
+ (let ((tmp-37332
($sc-dispatch
- x-29966
+ x-37330
'(_ each-any . #(each ((any . any) any))))))
- (if tmp-29968
+ (if tmp-37332
(@apply
- (lambda (k-29972
- keyword-29973
- pattern-29974
- template-29975)
+ (lambda (k-37336
+ keyword-37337
+ pattern-37338
+ template-37339)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
x
@@ -22391,12 +18071,21 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
(vector
'(#(syntax-object
@@ -22405,12 +18094,21 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
.
#(syntax-object
@@ -22419,12 +18117,21 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -22432,26 +18139,44 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- pattern-29974))
+ pattern-37338))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(cons '#(syntax-object
x
@@ -22459,18 +18184,27 @@
#(ribcage
#(k keyword pattern template)
#((top) (top) (top) (top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons k-29972
- (map (lambda (tmp-29940-29976
- tmp-29939-29977)
+ (cons k-37336
+ (map (lambda (tmp-37304-37340
+ tmp-37303-37341)
(list (cons '#(syntax-object
- dummy
+ _
((top)
#(ribcage
#(k
@@ -22481,10 +18215,10 @@
(top)
(top)
(top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage
()
()
@@ -22492,9 +18226,20 @@
#(ribcage
#(x)
#((top))
- #("l-*-29926")))
+ #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- tmp-29939-29977)
+ tmp-37303-37341)
(list '#(syntax-object
syntax
((top)
@@ -22507,10 +18252,10 @@
(top)
(top)
(top))
- #("l-*-29929"
- "l-*-29930"
- "l-*-29931"
- "l-*-29932"))
+ #("l-*-37293"
+ "l-*-37294"
+ "l-*-37295"
+ "l-*-37296"))
#(ribcage
()
()
@@ -22518,45 +18263,65 @@
#(ribcage
#(x)
#((top))
- #("l-*-29926")))
+ #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- tmp-29940-29976)))
- template-29975
- pattern-29974))))))
- tmp-29968)
- (let ((tmp-29978
+ tmp-37304-37340)))
+ template-37339
+ pattern-37338))))))
+ tmp-37332)
+ (let ((tmp-37342
($sc-dispatch
- x-29966
+ x-37330
'(_ each-any any . #(each ((any . any) any))))))
- (if (if tmp-29978
+ (if (if tmp-37342
(@apply
- (lambda (k-29982
- docstring-29983
- keyword-29984
- pattern-29985
- template-29986)
- (string? (syntax->datum docstring-29983)))
- tmp-29978)
+ (lambda (k-37346
+ docstring-37347
+ keyword-37348
+ pattern-37349
+ template-37350)
+ (string? (syntax->datum docstring-37347)))
+ tmp-37342)
#f)
(@apply
- (lambda (k-29987
- docstring-29988
- keyword-29989
- pattern-29990
- template-29991)
+ (lambda (k-37351
+ docstring-37352
+ keyword-37353
+ pattern-37354
+ template-37355)
(list '#(syntax-object
lambda
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
x
@@ -22564,15 +18329,24 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- docstring-29988
+ docstring-37352
(vector
'(#(syntax-object
macro-type
@@ -22580,13 +18354,22 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
.
#(syntax-object
@@ -22595,13 +18378,22 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
(cons '#(syntax-object
patterns
@@ -22609,28 +18401,46 @@
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- pattern-29990))
+ pattern-37354))
(cons '#(syntax-object
syntax-case
((top)
#(ribcage
#(k docstring keyword pattern template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-29926")))
+ #(ribcage #(x) #((top)) #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(cons '#(syntax-object
x
@@ -22642,22 +18452,28 @@
pattern
template)
#((top) (top) (top) (top) (top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-37290"))
#(ribcage
- #(x)
- #((top))
- #("l-*-29926")))
+ (syntax-rules)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons k-29987
- (map (lambda (tmp-29965-29992
- tmp-29964-29993)
+ (cons k-37351
+ (map (lambda (tmp-37329-37356
+ tmp-37328-37357)
(list (cons '#(syntax-object
- dummy
+ _
((top)
#(ribcage
#(k
@@ -22670,11 +18486,11 @@
(top)
(top)
(top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage
()
()
@@ -22682,10 +18498,21 @@
#(ribcage
#(x)
#((top))
- #("l-*-29926")))
+ #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- tmp-29964-29993)
+ tmp-37328-37357)
(list '#(syntax-object
syntax
((top)
@@ -22700,11 +18527,11 @@
(top)
(top)
(top))
- #("l-*-29952"
- "l-*-29953"
- "l-*-29954"
- "l-*-29955"
- "l-*-29956"))
+ #("l-*-37316"
+ "l-*-37317"
+ "l-*-37318"
+ "l-*-37319"
+ "l-*-37320"))
#(ribcage
()
()
@@ -22712,48 +18539,77 @@
#(ribcage
#(x)
#((top))
- #("l-*-29926")))
+ #("l-*-37290"))
+ #(ribcage
+ (syntax-rules)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ syntax-rules
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- tmp-29965-29992)))
- template-29991
- pattern-29990))))))
- tmp-29978)
+ tmp-37329-37356)))
+ template-37355
+ pattern-37354))))))
+ tmp-37342)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-29966))))))))
+ x-37330))))))))
(define define-syntax-rule
(make-syntax-transformer
'define-syntax-rule
'macro
- (lambda (x-30030)
- (let ((tmp-30032
- ($sc-dispatch x-30030 '(_ (any . any) any))))
- (if tmp-30032
+ (lambda (x-37395)
+ (let ((tmp-37397
+ ($sc-dispatch x-37395 '(_ (any . any) any))))
+ (if tmp-37397
(@apply
- (lambda (name-30036 pattern-30037 template-30038)
+ (lambda (name-37401 pattern-37402 template-37403)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-30007" "l-*-30008" "l-*-30009"))
+ #("l-*-37372" "l-*-37373" "l-*-37374"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30004")))
+ #(ribcage #(x) #((top)) #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- name-30036
+ name-37401
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-30007" "l-*-30008" "l-*-30009"))
+ #("l-*-37372" "l-*-37373" "l-*-37374"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30004")))
+ #(ribcage #(x) #((top)) #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'()
(list (cons '#(syntax-object
@@ -22762,63 +18618,90 @@
#(ribcage
#(name pattern template)
#((top) (top) (top))
- #("l-*-30007"
- "l-*-30008"
- "l-*-30009"))
+ #("l-*-37372"
+ "l-*-37373"
+ "l-*-37374"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30004")))
+ #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- pattern-30037)
- template-30038))))
- tmp-30032)
- (let ((tmp-30039
- ($sc-dispatch x-30030 '(_ (any . any) any any))))
- (if (if tmp-30039
+ pattern-37402)
+ template-37403))))
+ tmp-37397)
+ (let ((tmp-37404
+ ($sc-dispatch x-37395 '(_ (any . any) any any))))
+ (if (if tmp-37404
(@apply
- (lambda (name-30043
- pattern-30044
- docstring-30045
- template-30046)
- (string? (syntax->datum docstring-30045)))
- tmp-30039)
+ (lambda (name-37408
+ pattern-37409
+ docstring-37410
+ template-37411)
+ (string? (syntax->datum docstring-37410)))
+ tmp-37404)
#f)
(@apply
- (lambda (name-30047
- pattern-30048
- docstring-30049
- template-30050)
+ (lambda (name-37412
+ pattern-37413
+ docstring-37414
+ template-37415)
(list '#(syntax-object
define-syntax
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-30022"
- "l-*-30023"
- "l-*-30024"
- "l-*-30025"))
+ #("l-*-37387"
+ "l-*-37388"
+ "l-*-37389"
+ "l-*-37390"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30004")))
+ #(ribcage #(x) #((top)) #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- name-30047
+ name-37412
(list '#(syntax-object
syntax-rules
((top)
#(ribcage
#(name pattern docstring template)
#((top) (top) (top) (top))
- #("l-*-30022"
- "l-*-30023"
- "l-*-30024"
- "l-*-30025"))
+ #("l-*-37387"
+ "l-*-37388"
+ "l-*-37389"
+ "l-*-37390"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30004")))
+ #(ribcage #(x) #((top)) #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'()
- docstring-30049
+ docstring-37414
(list (cons '#(syntax-object
_
((top)
@@ -22828,45 +18711,54 @@
docstring
template)
#((top) (top) (top) (top))
- #("l-*-30022"
- "l-*-30023"
- "l-*-30024"
- "l-*-30025"))
+ #("l-*-37387"
+ "l-*-37388"
+ "l-*-37389"
+ "l-*-37390"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30004")))
+ #("l-*-37369"))
+ #(ribcage
+ (define-syntax-rule)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define-syntax-rule
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- pattern-30048)
- template-30050))))
- tmp-30039)
+ pattern-37413)
+ template-37415))))
+ tmp-37404)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-30030))))))))
+ x-37395))))))))
(define let*
(make-syntax-transformer
'let*
'macro
- (lambda (x-30099)
- (let ((tmp-30101
+ (lambda (x-37465)
+ (let ((tmp-37467
($sc-dispatch
- x-30099
+ x-37465
'(any #(each (any any)) any . each-any))))
- (if (if tmp-30101
+ (if (if tmp-37467
(@apply
- (lambda (let*-30105 x-30106 v-30107 e1-30108 e2-30109)
- (and-map identifier? x-30106))
- tmp-30101)
+ (lambda (let*-37471 x-37472 v-37473 e1-37474 e2-37475)
+ (and-map identifier? x-37472))
+ tmp-37467)
#f)
(@apply
- (lambda (let*-30110 x-30111 v-30112 e1-30113 e2-30114)
+ (lambda (let*-37476 x-37477 v-37478 e1-37479 e2-37480)
(letrec*
- ((f-30115
- (lambda (bindings-30118)
- (if (null? bindings-30118)
+ ((f-37481
+ (lambda (bindings-37484)
+ (if (null? bindings-37484)
(cons '#(syntax-object
let
((top)
@@ -22874,26 +18766,35 @@
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-30085" "l-*-30086"))
+ #("l-*-37451" "l-*-37452"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-30075"
- "l-*-30076"
- "l-*-30077"
- "l-*-30078"
- "l-*-30079"))
+ #("l-*-37441"
+ "l-*-37442"
+ "l-*-37443"
+ "l-*-37444"
+ "l-*-37445"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30061")))
+ #(ribcage #(x) #((top)) #("l-*-37427"))
+ #(ribcage
+ (let*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ let*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons '() (cons e1-30113 e2-30114)))
- (let ((tmp-30119
- (list (f-30115 (cdr bindings-30118))
- (car bindings-30118))))
- (let ((tmp-30120 ($sc-dispatch tmp-30119 '(any any))))
- (if tmp-30120
+ (cons '() (cons e1-37479 e2-37480)))
+ (let ((tmp-37485
+ (list (f-37481 (cdr bindings-37484))
+ (car bindings-37484))))
+ (let ((tmp-37486 ($sc-dispatch tmp-37485 '(any any))))
+ (if tmp-37486
(@apply
- (lambda (body-30122 binding-30123)
+ (lambda (body-37488 binding-37489)
(list '#(syntax-object
let
((top)
@@ -22901,84 +18802,93 @@
#(ribcage
#(body binding)
#((top) (top))
- #("l-*-30095" "l-*-30096"))
+ #("l-*-37461" "l-*-37462"))
#(ribcage () () ())
#(ribcage
#(f bindings)
#((top) (top))
- #("l-*-30085" "l-*-30086"))
+ #("l-*-37451" "l-*-37452"))
#(ribcage
#(let* x v e1 e2)
#((top) (top) (top) (top) (top))
- #("l-*-30075"
- "l-*-30076"
- "l-*-30077"
- "l-*-30078"
- "l-*-30079"))
+ #("l-*-37441"
+ "l-*-37442"
+ "l-*-37443"
+ "l-*-37444"
+ "l-*-37445"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30061")))
+ #("l-*-37427"))
+ #(ribcage
+ (let*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ let*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (list binding-30123)
- body-30122))
- tmp-30120)
+ (list binding-37489)
+ body-37488))
+ tmp-37486)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30119))))))))
- (f-30115 (map list x-30111 v-30112))))
- tmp-30101)
+ tmp-37485))))))))
+ (f-37481 (map list x-37477 v-37478))))
+ tmp-37467)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-30099))))))
+ x-37465))))))
(define do
(make-syntax-transformer
'do
'macro
- (lambda (orig-x-30181)
- (let ((tmp-30183
+ (lambda (orig-x-37548)
+ (let ((tmp-37550
($sc-dispatch
- orig-x-30181
+ orig-x-37548
'(_ #(each (any any . any))
(any . each-any)
.
each-any))))
- (if tmp-30183
+ (if tmp-37550
(@apply
- (lambda (var-30187
- init-30188
- step-30189
- e0-30190
- e1-30191
- c-30192)
- (let ((tmp-30193
- (map (lambda (v-30196 s-30197)
- (let ((tmp-30199 ($sc-dispatch s-30197 '())))
- (if tmp-30199
- (@apply (lambda () v-30196) tmp-30199)
- (let ((tmp-30202
- ($sc-dispatch s-30197 '(any))))
- (if tmp-30202
+ (lambda (var-37554
+ init-37555
+ step-37556
+ e0-37557
+ e1-37558
+ c-37559)
+ (let ((tmp-37560
+ (map (lambda (v-37563 s-37564)
+ (let ((tmp-37566 ($sc-dispatch s-37564 '())))
+ (if tmp-37566
+ (@apply (lambda () v-37563) tmp-37566)
+ (let ((tmp-37569
+ ($sc-dispatch s-37564 '(any))))
+ (if tmp-37569
(@apply
- (lambda (e-30205) e-30205)
- tmp-30202)
+ (lambda (e-37572) e-37572)
+ tmp-37569)
(syntax-violation
'do
"bad step expression"
- orig-x-30181
- s-30197))))))
- var-30187
- step-30189)))
- (let ((tmp-30194 ($sc-dispatch tmp-30193 'each-any)))
- (if tmp-30194
+ orig-x-37548
+ s-37564))))))
+ var-37554
+ step-37556)))
+ (let ((tmp-37561 ($sc-dispatch tmp-37560 'each-any)))
+ (if tmp-37561
(@apply
- (lambda (step-30211)
- (let ((tmp-30213 ($sc-dispatch e1-30191 '())))
- (if tmp-30213
+ (lambda (step-37578)
+ (let ((tmp-37580 ($sc-dispatch e1-37558 '())))
+ (if tmp-37580
(@apply
(lambda ()
(list '#(syntax-object
@@ -22988,7 +18898,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -22997,17 +18907,26 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'#(syntax-object
doloop
@@ -23016,7 +18935,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23025,19 +18944,28 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (map list var-30187 init-30188)
+ (map list var-37554 init-37555)
(list '#(syntax-object
if
((top)
@@ -23045,7 +18973,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23054,17 +18982,26 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list '#(syntax-object
not
@@ -23073,7 +19010,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23087,19 +19024,29 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- e0-30190)
+ e0-37557)
(cons '#(syntax-object
begin
((top)
@@ -23107,7 +19054,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23121,20 +19068,30 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
(append
- c-30192
+ c-37559
(list (cons '#(syntax-object
doloop
((top)
@@ -23145,7 +19102,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23159,12 +19116,12 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage
()
()
@@ -23172,28 +19129,39 @@
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- step-30211)))))))
- tmp-30213)
- (let ((tmp-30217
- ($sc-dispatch e1-30191 '(any . each-any))))
- (if tmp-30217
+ step-37578)))))))
+ tmp-37580)
+ (let ((tmp-37584
+ ($sc-dispatch e1-37558 '(any . each-any))))
+ (if tmp-37584
(@apply
- (lambda (e1-30221 e2-30222)
+ (lambda (e1-37588 e2-37589)
(list '#(syntax-object
let
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-30158" "l-*-30159"))
+ #("l-*-37525" "l-*-37526"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23202,17 +19170,26 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'#(syntax-object
doloop
@@ -23220,12 +19197,12 @@
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-30158" "l-*-30159"))
+ #("l-*-37525" "l-*-37526"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23234,32 +19211,41 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (map list var-30187 init-30188)
+ (map list var-37554 init-37555)
(list '#(syntax-object
if
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-30158"
- "l-*-30159"))
+ #("l-*-37525"
+ "l-*-37526"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var init step e0 e1 c)
#((top)
@@ -23268,32 +19254,41 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- e0-30190
+ e0-37557
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-30158"
- "l-*-30159"))
+ #("l-*-37525"
+ "l-*-37526"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23307,32 +19302,42 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- (cons e1-30221 e2-30222))
+ (cons e1-37588 e2-37589))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-30158"
- "l-*-30159"))
+ #("l-*-37525"
+ "l-*-37526"))
#(ribcage () () ())
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23346,20 +19351,30 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage () () ())
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
(append
- c-30192
+ c-37559
(list (cons '#(syntax-object
doloop
((top)
@@ -23368,8 +19383,8 @@
e2)
#((top)
(top))
- #("l-*-30158"
- "l-*-30159"))
+ #("l-*-37525"
+ "l-*-37526"))
#(ribcage
()
()
@@ -23377,7 +19392,7 @@
#(ribcage
#(step)
#((top))
- #("l-*-30149"))
+ #("l-*-37516"))
#(ribcage
#(var
init
@@ -23391,12 +19406,12 @@
(top)
(top)
(top))
- #("l-*-30134"
- "l-*-30135"
- "l-*-30136"
- "l-*-30137"
- "l-*-30138"
- "l-*-30139"))
+ #("l-*-37501"
+ "l-*-37502"
+ "l-*-37503"
+ "l-*-37504"
+ "l-*-37505"
+ "l-*-37506"))
#(ribcage
()
()
@@ -23404,36 +19419,47 @@
#(ribcage
#(orig-x)
#((top))
- #("l-*-30131")))
+ #("l-*-37498"))
+ #(ribcage
+ (do)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ do
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- step-30211)))))))
- tmp-30217)
+ step-37578)))))))
+ tmp-37584)
(syntax-violation
#f
"source expression failed to match any pattern"
- e1-30191))))))
- tmp-30194)
+ e1-37558))))))
+ tmp-37561)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30193)))))
- tmp-30183)
+ tmp-37560)))))
+ tmp-37550)
(syntax-violation
#f
"source expression failed to match any pattern"
- orig-x-30181))))))
+ orig-x-37548))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
'macro
(letrec*
- ((quasi-30508
- (lambda (p-30532 lev-30533)
- (let ((tmp-30535
+ ((quasi-37876
+ (lambda (p-37900 lev-37901)
+ (let ((tmp-37903
($sc-dispatch
- p-30532
+ p-37900
'(#(free-id
#(syntax-object
unquote
@@ -23442,7 +19468,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23451,28 +19477,37 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
any))))
- (if tmp-30535
+ (if tmp-37903
(@apply
- (lambda (p-30539)
- (if (= lev-30533 0)
+ (lambda (p-37907)
+ (if (= lev-37901 0)
(list '#(syntax-object
"value"
((top)
- #(ribcage #(p) #((top)) #("l-*-30258"))
+ #(ribcage #(p) #((top)) #("l-*-37626"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23481,25 +19516,34 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- p-30539)
- (quasicons-30510
+ p-37907)
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-30258"))
+ #(ribcage #(p) #((top)) #("l-*-37626"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23508,23 +19552,32 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-30258"))
+ #(ribcage #(p) #((top)) #("l-*-37626"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23533,19 +19586,28 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508 (list p-30539) (#{1-}# lev-30533)))))
- tmp-30535)
- (let ((tmp-30542
+ (quasi-37876 (list p-37907) (#{1-}# lev-37901)))))
+ tmp-37903)
+ (let ((tmp-37910
($sc-dispatch
- p-30532
+ p-37900
'(#(free-id
#(syntax-object
quasiquote
@@ -23554,7 +19616,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23563,28 +19625,37 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
any))))
- (if tmp-30542
+ (if tmp-37910
(@apply
- (lambda (p-30546)
- (quasicons-30510
+ (lambda (p-37914)
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-30261"))
+ #(ribcage #(p) #((top)) #("l-*-37629"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23593,23 +19664,32 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
quasiquote
((top)
- #(ribcage #(p) #((top)) #("l-*-30261"))
+ #(ribcage #(p) #((top)) #("l-*-37629"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23618,23 +19698,32 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508 (list p-30546) (#{1+}# lev-30533))))
- tmp-30542)
- (let ((tmp-30549 ($sc-dispatch p-30532 '(any . any))))
- (if tmp-30549
+ (quasi-37876 (list p-37914) (#{1+}# lev-37901))))
+ tmp-37910)
+ (let ((tmp-37917 ($sc-dispatch p-37900 '(any . any))))
+ (if tmp-37917
(@apply
- (lambda (p-30553 q-30554)
- (let ((tmp-30556
+ (lambda (p-37921 q-37922)
+ (let ((tmp-37924
($sc-dispatch
- p-30553
+ p-37921
'(#(free-id
#(syntax-object
unquote
@@ -23642,12 +19731,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23662,40 +19751,49 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
.
each-any))))
- (if tmp-30556
+ (if tmp-37924
(@apply
- (lambda (p-30560)
- (if (= lev-30533 0)
- (quasilist*-30512
- (map (lambda (tmp-30272-30596)
+ (lambda (p-37928)
+ (if (= lev-37901 0)
+ (quasilist*-37880
+ (map (lambda (tmp-37640-37967)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30270"))
+ #("l-*-37638"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264"
- "l-*-30265"))
+ #("l-*-37632"
+ "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254"
- "l-*-30255"))
+ #("l-*-37622"
+ "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23710,35 +19808,45 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- tmp-30272-30596))
- p-30560)
- (quasi-30508 q-30554 lev-30533))
- (quasicons-30510
- (quasicons-30510
+ tmp-37640-37967))
+ p-37928)
+ (quasi-37876 q-37922 lev-37901))
+ (quasicons-37878
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30270"))
+ #("l-*-37638"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23753,13 +19861,22 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
unquote
@@ -23767,16 +19884,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-30270"))
+ #("l-*-37638"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23791,22 +19908,31 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508
- p-30560
- (#{1-}# lev-30533)))
- (quasi-30508 q-30554 lev-30533))))
- tmp-30556)
- (let ((tmp-30601
+ (quasi-37876
+ p-37928
+ (#{1-}# lev-37901)))
+ (quasi-37876 q-37922 lev-37901))))
+ tmp-37924)
+ (let ((tmp-37972
($sc-dispatch
- p-30553
+ p-37921
'(#(free-id
#(syntax-object
unquote-splicing
@@ -23814,12 +19940,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23834,40 +19960,49 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
.
each-any))))
- (if tmp-30601
+ (if tmp-37972
(@apply
- (lambda (p-30605)
- (if (= lev-30533 0)
- (quasiappend-30511
- (map (lambda (tmp-30277-30608)
+ (lambda (p-37976)
+ (if (= lev-37901 0)
+ (quasiappend-37879
+ (map (lambda (tmp-37645-37979)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30275"))
+ #("l-*-37643"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264"
- "l-*-30265"))
+ #("l-*-37632"
+ "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254"
- "l-*-30255"))
+ #("l-*-37622"
+ "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23882,35 +20017,45 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- tmp-30277-30608))
- p-30605)
- (quasi-30508 q-30554 lev-30533))
- (quasicons-30510
- (quasicons-30510
+ tmp-37645-37979))
+ p-37976)
+ (quasi-37876 q-37922 lev-37901))
+ (quasicons-37878
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30275"))
+ #("l-*-37643"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23925,13 +20070,22 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -23939,16 +20093,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-30275"))
+ #("l-*-37643"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30264" "l-*-30265"))
+ #("l-*-37632" "l-*-37633"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -23963,49 +20117,58 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508
- p-30605
- (#{1-}# lev-30533)))
- (quasi-30508 q-30554 lev-30533))))
- tmp-30601)
- (quasicons-30510
- (quasi-30508 p-30553 lev-30533)
- (quasi-30508 q-30554 lev-30533)))))))
- tmp-30549)
- (let ((tmp-30622
- ($sc-dispatch p-30532 '#(vector each-any))))
- (if tmp-30622
+ (quasi-37876
+ p-37976
+ (#{1-}# lev-37901)))
+ (quasi-37876 q-37922 lev-37901))))
+ tmp-37972)
+ (quasicons-37878
+ (quasi-37876 p-37921 lev-37901)
+ (quasi-37876 q-37922 lev-37901)))))))
+ tmp-37917)
+ (let ((tmp-37993
+ ($sc-dispatch p-37900 '#(vector each-any))))
+ (if tmp-37993
(@apply
- (lambda (x-30626)
- (let ((x-30629
- (vquasi-30509 x-30626 lev-30533)))
- (let ((tmp-30631
+ (lambda (x-37997)
+ (let ((x-38000
+ (vquasi-37877 x-37997 lev-37901)))
+ (let ((tmp-38002
($sc-dispatch
- x-30629
+ x-38000
'(#(atom "quote") each-any))))
- (if tmp-30631
+ (if tmp-38002
(@apply
- (lambda (x-30635)
+ (lambda (x-38006)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(x)
#((top))
- #("l-*-30382"))
+ #("l-*-37750"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30379"))
+ #("l-*-37747"))
#(ribcage
(emit quasivector
quasilist*
@@ -24020,36 +20183,45 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (list->vector x-30635)))
- tmp-30631)
+ (list->vector x-38006)))
+ tmp-38002)
(letrec*
- ((f-30637
- (lambda (y-30649 k-30650)
- (let ((tmp-30652
+ ((f-38008
+ (lambda (y-38020 k-38021)
+ (let ((tmp-38023
($sc-dispatch
- y-30649
+ y-38020
'(#(atom "quote")
each-any))))
- (if tmp-30652
+ (if tmp-38023
(@apply
- (lambda (y-30655)
- (k-30650
- (map (lambda (tmp-30407-30656)
+ (lambda (y-38026)
+ (k-38021
+ (map (lambda (tmp-37775-38027)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(y)
#((top))
- #("l-*-30405"))
+ #("l-*-37773"))
#(ribcage
()
()
@@ -24061,13 +20233,13 @@
#((top)
(top)
(top))
- #("l-*-30387"
- "l-*-30388"
- "l-*-30389"))
+ #("l-*-37755"
+ "l-*-37756"
+ "l-*-37757"))
#(ribcage
#(_)
#((top))
- #("l-*-30385"))
+ #("l-*-37753"))
#(ribcage
()
()
@@ -24075,7 +20247,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-30379"))
+ #("l-*-37747"))
#(ribcage
(emit quasivector
quasilist*
@@ -24090,50 +20262,61 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- tmp-30407-30656))
- y-30655)))
- tmp-30652)
- (let ((tmp-30657
+ tmp-37775-38027))
+ y-38026)))
+ tmp-38023)
+ (let ((tmp-38028
($sc-dispatch
- y-30649
+ y-38020
'(#(atom "list")
.
each-any))))
- (if tmp-30657
+ (if tmp-38028
(@apply
- (lambda (y-30660)
- (k-30650 y-30660))
- tmp-30657)
- (let ((tmp-30661
+ (lambda (y-38031)
+ (k-38021 y-38031))
+ tmp-38028)
+ (let ((tmp-38032
($sc-dispatch
- y-30649
+ y-38020
'(#(atom "list*")
.
#(each+
any
(any)
())))))
- (if tmp-30661
+ (if tmp-38032
(@apply
- (lambda (y-30664
- z-30665)
- (f-30637
- z-30665
- (lambda (ls-30666)
- (k-30650
+ (lambda (y-38035
+ z-38036)
+ (f-38008
+ z-38036
+ (lambda (ls-38037)
+ (k-38021
(append
- y-30664
- ls-30666)))))
- tmp-30661)
+ y-38035
+ ls-38037)))))
+ tmp-38032)
(list '#(syntax-object
"list->vector"
((top)
@@ -24142,14 +20325,14 @@
()
())
#(ribcage
- #(t-30422)
- #((m-*-30423
+ #(t-37790)
+ #((m-*-37791
top))
- #("l-*-30426"))
+ #("l-*-37794"))
#(ribcage
#(else)
#((top))
- #("l-*-30420"))
+ #("l-*-37788"))
#(ribcage
()
()
@@ -24159,13 +20342,13 @@
#((top)
(top)
(top))
- #("l-*-30387"
- "l-*-30388"
- "l-*-30389"))
+ #("l-*-37755"
+ "l-*-37756"
+ "l-*-37757"))
#(ribcage
#(_)
#((top))
- #("l-*-30385"))
+ #("l-*-37753"))
#(ribcage
()
()
@@ -24173,7 +20356,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-30379"))
+ #("l-*-37747"))
#(ribcage
(emit quasivector
quasilist*
@@ -24188,26 +20371,37 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- x-30629))))))))))
- (f-30637
- x-30629
- (lambda (ls-30639)
- (let ((tmp-30641
+ x-38000))))))))))
+ (f-38008
+ x-38000
+ (lambda (ls-38010)
+ (let ((tmp-38012
($sc-dispatch
- ls-30639
+ ls-38010
'each-any)))
- (if tmp-30641
+ (if tmp-38012
(@apply
- (lambda (t-30395-30644)
+ (lambda (t-37763-38015)
(cons '#(syntax-object
"vector"
((top)
@@ -24216,10 +20410,10 @@
()
())
#(ribcage
- #(t-30395)
- #((m-*-30396
+ #(t-37763)
+ #((m-*-37764
top))
- #("l-*-30400"))
+ #("l-*-37768"))
#(ribcage
()
()
@@ -24235,11 +20429,11 @@
#(ribcage
#(ls)
#((top))
- #("l-*-30394"))
+ #("l-*-37762"))
#(ribcage
#(_)
#((top))
- #("l-*-30385"))
+ #("l-*-37753"))
#(ribcage
()
()
@@ -24247,7 +20441,7 @@
#(ribcage
#(x)
#((top))
- #("l-*-30379"))
+ #("l-*-37747"))
#(ribcage
(emit quasivector
quasilist*
@@ -24262,30 +20456,41 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- t-30395-30644))
- tmp-30641)
+ t-37763-38015))
+ tmp-38012)
(syntax-violation
#f
"source expression failed to match any pattern"
- ls-30639))))))))))
- tmp-30622)
+ ls-38010))))))))))
+ tmp-37993)
(list '#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-30285"))
+ #(ribcage #(p) #((top)) #("l-*-37653"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30254" "l-*-30255"))
+ #("l-*-37622" "l-*-37623"))
#(ribcage
(emit quasivector
quasilist*
@@ -24300,24 +20505,33 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- p-30532)))))))))))
- (vquasi-30509
- (lambda (p-30694 lev-30695)
- (let ((tmp-30697 ($sc-dispatch p-30694 '(any . any))))
- (if tmp-30697
+ p-37900)))))))))))
+ (vquasi-37877
+ (lambda (p-38065 lev-38066)
+ (let ((tmp-38068 ($sc-dispatch p-38065 '(any . any))))
+ (if tmp-38068
(@apply
- (lambda (p-30701 q-30702)
- (let ((tmp-30704
+ (lambda (p-38072 q-38073)
+ (let ((tmp-38075
($sc-dispatch
- p-30701
+ p-38072
'(#(free-id
#(syntax-object
unquote
@@ -24325,12 +20539,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24345,38 +20559,47 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
.
each-any))))
- (if tmp-30704
+ (if tmp-38075
(@apply
- (lambda (p-30708)
- (if (= lev-30695 0)
- (quasilist*-30512
- (map (lambda (tmp-30301-30744)
+ (lambda (p-38079)
+ (if (= lev-38066 0)
+ (quasilist*-37880
+ (map (lambda (tmp-37669-38118)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30299"))
+ #("l-*-37667"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24391,32 +20614,41 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- tmp-30301-30744))
- p-30708)
- (vquasi-30509 q-30702 lev-30695))
- (quasicons-30510
- (quasicons-30510
+ tmp-37669-38118))
+ p-38079)
+ (vquasi-37877 q-38073 lev-38066))
+ (quasicons-37878
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
- #(ribcage #(p) #((top)) #("l-*-30299"))
+ #(ribcage #(p) #((top)) #("l-*-37667"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24431,27 +20663,36 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
unquote
((top)
- #(ribcage #(p) #((top)) #("l-*-30299"))
+ #(ribcage #(p) #((top)) #("l-*-37667"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24466,20 +20707,29 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508 p-30708 (#{1-}# lev-30695)))
- (vquasi-30509 q-30702 lev-30695))))
- tmp-30704)
- (let ((tmp-30751
+ (quasi-37876 p-38079 (#{1-}# lev-38066)))
+ (vquasi-37877 q-38073 lev-38066))))
+ tmp-38075)
+ (let ((tmp-38125
($sc-dispatch
- p-30701
+ p-38072
'(#(free-id
#(syntax-object
unquote-splicing
@@ -24487,12 +20737,12 @@
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24507,40 +20757,49 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
.
each-any))))
- (if tmp-30751
+ (if tmp-38125
(@apply
- (lambda (p-30755)
- (if (= lev-30695 0)
- (quasiappend-30511
- (map (lambda (tmp-30306-30758)
+ (lambda (p-38129)
+ (if (= lev-38066 0)
+ (quasiappend-37879
+ (map (lambda (tmp-37674-38132)
(list '#(syntax-object
"value"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30304"))
+ #("l-*-37672"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293"
- "l-*-30294"))
+ #("l-*-37661"
+ "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289"
- "l-*-30290"))
+ #("l-*-37657"
+ "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24555,35 +20814,44 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- tmp-30306-30758))
- p-30755)
- (vquasi-30509 q-30702 lev-30695))
- (quasicons-30510
- (quasicons-30510
+ tmp-37674-38132))
+ p-38129)
+ (vquasi-37877 q-38073 lev-38066))
+ (quasicons-37878
+ (quasicons-37878
'(#(syntax-object
"quote"
((top)
#(ribcage
#(p)
#((top))
- #("l-*-30304"))
+ #("l-*-37672"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24598,13 +20866,22 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
unquote-splicing
@@ -24612,16 +20889,16 @@
#(ribcage
#(p)
#((top))
- #("l-*-30304"))
+ #("l-*-37672"))
#(ribcage
#(p q)
#((top) (top))
- #("l-*-30293" "l-*-30294"))
+ #("l-*-37661" "l-*-37662"))
#(ribcage () () ())
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24636,23 +20913,32 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
- (quasi-30508 p-30755 (#{1-}# lev-30695)))
- (vquasi-30509 q-30702 lev-30695))))
- tmp-30751)
- (quasicons-30510
- (quasi-30508 p-30701 lev-30695)
- (vquasi-30509 q-30702 lev-30695)))))))
- tmp-30697)
- (let ((tmp-30776 ($sc-dispatch p-30694 '())))
- (if tmp-30776
+ (quasi-37876 p-38129 (#{1-}# lev-38066)))
+ (vquasi-37877 q-38073 lev-38066))))
+ tmp-38125)
+ (quasicons-37878
+ (quasi-37876 p-38072 lev-38066)
+ (vquasi-37877 q-38073 lev-38066)))))))
+ tmp-38068)
+ (let ((tmp-38150 ($sc-dispatch p-38065 '())))
+ (if tmp-38150
(@apply
(lambda ()
'(#(syntax-object
@@ -24662,7 +20948,7 @@
#(ribcage
#(p lev)
#((top) (top))
- #("l-*-30289" "l-*-30290"))
+ #("l-*-37657" "l-*-37658"))
#(ribcage
(emit quasivector
quasilist*
@@ -24671,61 +20957,70 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
()))
- tmp-30776)
+ tmp-38150)
(syntax-violation
#f
"source expression failed to match any pattern"
- p-30694)))))))
- (quasicons-30510
- (lambda (x-30789 y-30790)
- (let ((tmp-30791 (list x-30789 y-30790)))
- (let ((tmp-30792 ($sc-dispatch tmp-30791 '(any any))))
- (if tmp-30792
+ p-38065)))))))
+ (quasicons-37878
+ (lambda (x-38163 y-38164)
+ (let ((tmp-38165 (list x-38163 y-38164)))
+ (let ((tmp-38166 ($sc-dispatch tmp-38165 '(any any))))
+ (if tmp-38166
(@apply
- (lambda (x-30794 y-30795)
- (let ((tmp-30797
- ($sc-dispatch y-30795 '(#(atom "quote") any))))
- (if tmp-30797
+ (lambda (x-38168 y-38169)
+ (let ((tmp-38171
+ ($sc-dispatch y-38169 '(#(atom "quote") any))))
+ (if tmp-38171
(@apply
- (lambda (dy-30801)
- (let ((tmp-30803
+ (lambda (dy-38175)
+ (let ((tmp-38177
($sc-dispatch
- x-30794
+ x-38168
'(#(atom "quote") any))))
- (if tmp-30803
+ (if tmp-38177
(@apply
- (lambda (dx-30807)
+ (lambda (dx-38181)
(list '#(syntax-object
"quote"
((top)
#(ribcage
#(dx)
#((top))
- #("l-*-30328"))
+ #("l-*-37696"))
#(ribcage
#(dy)
#((top))
- #("l-*-30324"))
+ #("l-*-37692"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24740,39 +21035,48 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons dx-30807 dy-30801)))
- tmp-30803)
- (if (null? dy-30801)
+ (cons dx-38181 dy-38175)))
+ tmp-38177)
+ (if (null? dy-38175)
(list '#(syntax-object
"list"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-30330"))
+ #("l-*-37698"))
#(ribcage
#(dy)
#((top))
- #("l-*-30324"))
+ #("l-*-37692"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24787,37 +21091,46 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- x-30794)
+ x-38168)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-30330"))
+ #("l-*-37698"))
#(ribcage
#(dy)
#((top))
- #("l-*-30324"))
+ #("l-*-37692"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24832,42 +21145,51 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- x-30794
- y-30795)))))
- tmp-30797)
- (let ((tmp-30812
+ x-38168
+ y-38169)))))
+ tmp-38171)
+ (let ((tmp-38186
($sc-dispatch
- y-30795
+ y-38169
'(#(atom "list") . any))))
- (if tmp-30812
+ (if tmp-38186
(@apply
- (lambda (stuff-30816)
+ (lambda (stuff-38190)
(cons '#(syntax-object
"list"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-30333"))
+ #("l-*-37701"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24882,41 +21204,50 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons x-30794 stuff-30816)))
- tmp-30812)
- (let ((tmp-30817
+ (cons x-38168 stuff-38190)))
+ tmp-38186)
+ (let ((tmp-38191
($sc-dispatch
- y-30795
+ y-38169
'(#(atom "list*") . any))))
- (if tmp-30817
+ (if tmp-38191
(@apply
- (lambda (stuff-30821)
+ (lambda (stuff-38195)
(cons '#(syntax-object
"list*"
((top)
#(ribcage
#(stuff)
#((top))
- #("l-*-30336"))
+ #("l-*-37704"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24931,34 +21262,43 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons x-30794 stuff-30821)))
- tmp-30817)
+ (cons x-38168 stuff-38195)))
+ tmp-38191)
(list '#(syntax-object
"list*"
((top)
#(ribcage
#(_)
#((top))
- #("l-*-30338"))
+ #("l-*-37706"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30318" "l-*-30319"))
+ #("l-*-37686" "l-*-37687"))
#(ribcage () () ())
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30313" "l-*-30314"))
+ #("l-*-37681" "l-*-37682"))
#(ribcage
(emit quasivector
quasilist*
@@ -24973,29 +21313,38 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- x-30794
- y-30795))))))))
- tmp-30792)
+ x-38168
+ y-38169))))))))
+ tmp-38166)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30791))))))
- (quasiappend-30511
- (lambda (x-30832 y-30833)
- (let ((tmp-30835
- ($sc-dispatch y-30833 '(#(atom "quote") ()))))
- (if tmp-30835
+ tmp-38165))))))
+ (quasiappend-37879
+ (lambda (x-38206 y-38207)
+ (let ((tmp-38209
+ ($sc-dispatch y-38207 '(#(atom "quote") ()))))
+ (if tmp-38209
(@apply
(lambda ()
- (if (null? x-30832)
+ (if (null? x-38206)
'(#(syntax-object
"quote"
((top)
@@ -25003,7 +21352,7 @@
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30342" "l-*-30343"))
+ #("l-*-37710" "l-*-37711"))
#(ribcage
(emit quasivector
quasilist*
@@ -25012,21 +21361,30 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
())
- (if (null? (cdr x-30832))
- (car x-30832)
- (let ((tmp-30840 ($sc-dispatch x-30832 'each-any)))
- (if tmp-30840
+ (if (null? (cdr x-38206))
+ (car x-38206)
+ (let ((tmp-38214 ($sc-dispatch x-38206 'each-any)))
+ (if tmp-38214
(@apply
- (lambda (p-30844)
+ (lambda (p-38218)
(cons '#(syntax-object
"append"
((top)
@@ -25034,12 +21392,12 @@
#(ribcage
#(p)
#((top))
- #("l-*-30354"))
+ #("l-*-37722"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30342" "l-*-30343"))
+ #("l-*-37710" "l-*-37711"))
#(ribcage
(emit quasivector
quasilist*
@@ -25054,29 +21412,38 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- p-30844))
- tmp-30840)
+ p-38218))
+ tmp-38214)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-30832))))))
- tmp-30835)
- (if (null? x-30832)
- y-30833
- (let ((tmp-30852 (list x-30832 y-30833)))
- (let ((tmp-30853
- ($sc-dispatch tmp-30852 '(each-any any))))
- (if tmp-30853
+ x-38206))))))
+ tmp-38209)
+ (if (null? x-38206)
+ y-38207
+ (let ((tmp-38226 (list x-38206 y-38207)))
+ (let ((tmp-38227
+ ($sc-dispatch tmp-38226 '(each-any any))))
+ (if tmp-38227
(@apply
- (lambda (p-30855 y-30856)
+ (lambda (p-38229 y-38230)
(cons '#(syntax-object
"append"
((top)
@@ -25084,13 +21451,13 @@
#(ribcage
#(p y)
#((top) (top))
- #("l-*-30365" "l-*-30366"))
- #(ribcage #(_) #((top)) #("l-*-30357"))
+ #("l-*-37733" "l-*-37734"))
+ #(ribcage #(_) #((top)) #("l-*-37725"))
#(ribcage () () ())
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30342" "l-*-30343"))
+ #("l-*-37710" "l-*-37711"))
#(ribcage
(emit quasivector
quasilist*
@@ -25105,44 +21472,53 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (append p-30855 (list y-30856))))
- tmp-30853)
+ (append p-38229 (list y-38230))))
+ tmp-38227)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30852)))))))))
- (quasilist*-30512
- (lambda (x-30860 y-30861)
+ tmp-38226)))))))))
+ (quasilist*-37880
+ (lambda (x-38234 y-38235)
(letrec*
- ((f-30862
- (lambda (x-30951)
- (if (null? x-30951)
- y-30861
- (quasicons-30510
- (car x-30951)
- (f-30862 (cdr x-30951)))))))
- (f-30862 x-30860))))
- (emit-30514
- (lambda (x-30954)
- (let ((tmp-30956
- ($sc-dispatch x-30954 '(#(atom "quote") any))))
- (if tmp-30956
+ ((f-38236
+ (lambda (x-38340)
+ (if (null? x-38340)
+ y-38235
+ (quasicons-37878
+ (car x-38340)
+ (f-38236 (cdr x-38340)))))))
+ (f-38236 x-38234))))
+ (emit-37882
+ (lambda (x-38343)
+ (let ((tmp-38345
+ ($sc-dispatch x-38343 '(#(atom "quote") any))))
+ (if tmp-38345
(@apply
- (lambda (x-30960)
+ (lambda (x-38349)
(list '#(syntax-object
quote
((top)
- #(ribcage #(x) #((top)) #("l-*-30432"))
+ #(ribcage #(x) #((top)) #("l-*-37800"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-30429"))
+ #(ribcage #(x) #((top)) #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25151,45 +21527,54 @@
vquasi
quasi)
((top) (top) (top) (top) (top) (top) (top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- x-30960))
- tmp-30956)
- (let ((tmp-30961
+ x-38349))
+ tmp-38345)
+ (let ((tmp-38350
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "list") . each-any))))
- (if tmp-30961
+ (if tmp-38350
(@apply
- (lambda (x-30965)
- (let ((tmp-30966 (map emit-30514 x-30965)))
- (let ((tmp-30967 ($sc-dispatch tmp-30966 'each-any)))
- (if tmp-30967
+ (lambda (x-38354)
+ (let ((tmp-38355 (map emit-37882 x-38354)))
+ (let ((tmp-38356 ($sc-dispatch tmp-38355 'each-any)))
+ (if tmp-38356
(@apply
- (lambda (t-30437-30969)
+ (lambda (t-37805-38358)
(cons '#(syntax-object
list
((top)
#(ribcage () () ())
#(ribcage
- #(t-30437)
- #((m-*-30438 top))
- #("l-*-30442"))
+ #(t-37805)
+ #((m-*-37806 top))
+ #("l-*-37810"))
#(ribcage
#(x)
#((top))
- #("l-*-30435"))
+ #("l-*-37803"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30429"))
+ #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25204,70 +21589,79 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- t-30437-30969))
- tmp-30967)
+ t-37805-38358))
+ tmp-38356)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30966)))))
- tmp-30961)
- (let ((tmp-30970
+ tmp-38355)))))
+ tmp-38350)
+ (let ((tmp-38359
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "list*") . #(each+ any (any) ())))))
- (if tmp-30970
+ (if tmp-38359
(@apply
- (lambda (x-30974 y-30975)
+ (lambda (x-38363 y-38364)
(letrec*
- ((f-30976
- (lambda (x*-30979)
- (if (null? x*-30979)
- (emit-30514 y-30975)
- (let ((tmp-30980
- (list (emit-30514 (car x*-30979))
- (f-30976 (cdr x*-30979)))))
- (let ((tmp-30981
+ ((f-38365
+ (lambda (x*-38368)
+ (if (null? x*-38368)
+ (emit-37882 y-38364)
+ (let ((tmp-38369
+ (list (emit-37882 (car x*-38368))
+ (f-38365 (cdr x*-38368)))))
+ (let ((tmp-38370
($sc-dispatch
- tmp-30980
+ tmp-38369
'(any any))))
- (if tmp-30981
+ (if tmp-38370
(@apply
- (lambda (t-30457-30983
- t-30456-30984)
+ (lambda (t-37825-38372
+ t-37824-38373)
(list '#(syntax-object
cons
((top)
#(ribcage () () ())
#(ribcage
- #(t-30457 t-30456)
- #((m-*-30458 top)
- (m-*-30458 top))
- #("l-*-30462"
- "l-*-30463"))
+ #(t-37825 t-37824)
+ #((m-*-37826 top)
+ (m-*-37826 top))
+ #("l-*-37830"
+ "l-*-37831"))
#(ribcage () () ())
#(ribcage
#(f x*)
#((top) (top))
- #("l-*-30451"
- "l-*-30452"))
+ #("l-*-37819"
+ "l-*-37820"))
#(ribcage
#(x y)
#((top) (top))
- #("l-*-30447"
- "l-*-30448"))
+ #("l-*-37815"
+ "l-*-37816"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30429"))
+ #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25282,53 +21676,63 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- t-30457-30983
- t-30456-30984))
- tmp-30981)
+ t-37825-38372
+ t-37824-38373))
+ tmp-38370)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30980))))))))
- (f-30976 x-30974)))
- tmp-30970)
- (let ((tmp-30985
+ tmp-38369))))))))
+ (f-38365 x-38363)))
+ tmp-38359)
+ (let ((tmp-38374
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "append") . each-any))))
- (if tmp-30985
+ (if tmp-38374
(@apply
- (lambda (x-30989)
- (let ((tmp-30990 (map emit-30514 x-30989)))
- (let ((tmp-30991
- ($sc-dispatch tmp-30990 'each-any)))
- (if tmp-30991
+ (lambda (x-38378)
+ (let ((tmp-38379 (map emit-37882 x-38378)))
+ (let ((tmp-38380
+ ($sc-dispatch tmp-38379 'each-any)))
+ (if tmp-38380
(@apply
- (lambda (t-30469-30993)
+ (lambda (t-37837-38382)
(cons '#(syntax-object
append
((top)
#(ribcage () () ())
#(ribcage
- #(t-30469)
- #((m-*-30470 top))
- #("l-*-30474"))
+ #(t-37837)
+ #((m-*-37838 top))
+ #("l-*-37842"))
#(ribcage
#(x)
#((top))
- #("l-*-30467"))
+ #("l-*-37835"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30429"))
+ #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25343,53 +21747,62 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- t-30469-30993))
- tmp-30991)
+ t-37837-38382))
+ tmp-38380)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30990)))))
- tmp-30985)
- (let ((tmp-30994
+ tmp-38379)))))
+ tmp-38374)
+ (let ((tmp-38383
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "vector") . each-any))))
- (if tmp-30994
+ (if tmp-38383
(@apply
- (lambda (x-30998)
- (let ((tmp-30999 (map emit-30514 x-30998)))
- (let ((tmp-31000
+ (lambda (x-38387)
+ (let ((tmp-38388 (map emit-37882 x-38387)))
+ (let ((tmp-38389
($sc-dispatch
- tmp-30999
+ tmp-38388
'each-any)))
- (if tmp-31000
+ (if tmp-38389
(@apply
- (lambda (t-30481-31002)
+ (lambda (t-37849-38391)
(cons '#(syntax-object
vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-30481)
- #((m-*-30482 top))
- #("l-*-30486"))
+ #(t-37849)
+ #((m-*-37850 top))
+ #("l-*-37854"))
#(ribcage
#(x)
#((top))
- #("l-*-30479"))
+ #("l-*-37847"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30429"))
+ #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25404,46 +21817,56 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- t-30481-31002))
- tmp-31000)
+ t-37849-38391))
+ tmp-38389)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-30999)))))
- tmp-30994)
- (let ((tmp-31003
+ tmp-38388)))))
+ tmp-38383)
+ (let ((tmp-38392
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "list->vector") any))))
- (if tmp-31003
+ (if tmp-38392
(@apply
- (lambda (x-31007)
- (let ((tmp-31008 (emit-30514 x-31007)))
+ (lambda (x-38396)
+ (let ((tmp-38397 (emit-37882 x-38396)))
(list '#(syntax-object
list->vector
((top)
#(ribcage () () ())
#(ribcage
- #(t-30493)
- #((m-*-30494 top))
- #("l-*-30497"))
+ #(t-37861)
+ #((m-*-37862 top))
+ #("l-*-37865"))
#(ribcage
#(x)
#((top))
- #("l-*-30491"))
+ #("l-*-37859"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-30429"))
+ #("l-*-37797"))
#(ribcage
(emit quasivector
quasilist*
@@ -25458,183 +21881,210 @@
(top)
(top)
(top))
- ("l-*-30250"
- "l-*-30248"
- "l-*-30246"
- "l-*-30244"
- "l-*-30242"
- "l-*-30240"
- "l-*-30238")))
+ ("l-*-37618"
+ "l-*-37616"
+ "l-*-37614"
+ "l-*-37612"
+ "l-*-37610"
+ "l-*-37608"
+ "l-*-37606"))
+ #(ribcage
+ (quasiquote)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ quasiquote
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- tmp-31008)))
- tmp-31003)
- (let ((tmp-31011
+ tmp-38397)))
+ tmp-38392)
+ (let ((tmp-38400
($sc-dispatch
- x-30954
+ x-38343
'(#(atom "value") any))))
- (if tmp-31011
+ (if tmp-38400
(@apply
- (lambda (x-31015) x-31015)
- tmp-31011)
+ (lambda (x-38404) x-38404)
+ tmp-38400)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-30954))))))))))))))))))
- (lambda (x-30515)
- (let ((tmp-30517 ($sc-dispatch x-30515 '(_ any))))
- (if tmp-30517
+ x-38343))))))))))))))))))
+ (lambda (x-37883)
+ (let ((tmp-37885 ($sc-dispatch x-37883 '(_ any))))
+ (if tmp-37885
(@apply
- (lambda (e-30521)
- (emit-30514 (quasi-30508 e-30521 0)))
- tmp-30517)
+ (lambda (e-37889)
+ (emit-37882 (quasi-37876 e-37889 0)))
+ tmp-37885)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-30515)))))))
+ x-37883)))))))
(define include
(make-syntax-transformer
'include
'macro
- (lambda (x-31070)
+ (lambda (x-38460)
(letrec*
- ((read-file-31071
- (lambda (fn-31180 k-31181)
- (let ((p-31182 (open-input-file fn-31180)))
+ ((read-file-38461
+ (lambda (fn-38570 k-38571)
+ (let ((p-38572 (open-input-file fn-38570)))
(letrec*
- ((f-31183
- (lambda (x-31237 result-31238)
- (if (eof-object? x-31237)
+ ((f-38573
+ (lambda (x-38627 result-38628)
+ (if (eof-object? x-38627)
(begin
- (close-input-port p-31182)
- (reverse result-31238))
- (f-31183
- (read p-31182)
- (cons (datum->syntax k-31181 x-31237)
- result-31238))))))
- (f-31183 (read p-31182) '()))))))
- (let ((tmp-31073 ($sc-dispatch x-31070 '(any any))))
- (if tmp-31073
+ (close-input-port p-38572)
+ (reverse result-38628))
+ (f-38573
+ (read p-38572)
+ (cons (datum->syntax k-38571 x-38627)
+ result-38628))))))
+ (f-38573 (read p-38572) '()))))))
+ (let ((tmp-38463 ($sc-dispatch x-38460 '(any any))))
+ (if tmp-38463
(@apply
- (lambda (k-31077 filename-31078)
- (let ((fn-31079 (syntax->datum filename-31078)))
- (let ((tmp-31080
- (read-file-31071 fn-31079 filename-31078)))
- (let ((tmp-31081 ($sc-dispatch tmp-31080 'each-any)))
- (if tmp-31081
+ (lambda (k-38467 filename-38468)
+ (let ((fn-38469 (syntax->datum filename-38468)))
+ (let ((tmp-38470
+ (read-file-38461 fn-38469 filename-38468)))
+ (let ((tmp-38471 ($sc-dispatch tmp-38470 'each-any)))
+ (if tmp-38471
(@apply
- (lambda (exp-31099)
+ (lambda (exp-38489)
(cons '#(syntax-object
begin
((top)
#(ribcage () () ())
- #(ribcage #(exp) #((top)) #("l-*-31067"))
+ #(ribcage #(exp) #((top)) #("l-*-38457"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-31062"))
+ #(ribcage #(fn) #((top)) #("l-*-38452"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-31058" "l-*-31059"))
+ #("l-*-38448" "l-*-38449"))
#(ribcage
(read-file)
((top))
- ("l-*-31042"))
- #(ribcage #(x) #((top)) #("l-*-31041")))
+ ("l-*-38432"))
+ #(ribcage #(x) #((top)) #("l-*-38431"))
+ #(ribcage
+ (include)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ include
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- exp-31099))
- tmp-31081)
+ exp-38489))
+ tmp-38471)
(syntax-violation
#f
"source expression failed to match any pattern"
- tmp-31080))))))
- tmp-31073)
+ tmp-38470))))))
+ tmp-38463)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-31070)))))))
+ x-38460)))))))
(define include-from-path
(make-syntax-transformer
'include-from-path
'macro
- (lambda (x-31257)
- (let ((tmp-31259 ($sc-dispatch x-31257 '(any any))))
- (if tmp-31259
+ (lambda (x-38648)
+ (let ((tmp-38650 ($sc-dispatch x-38648 '(any any))))
+ (if tmp-38650
(@apply
- (lambda (k-31263 filename-31264)
- (let ((fn-31265 (syntax->datum filename-31264)))
- (let ((tmp-31266
+ (lambda (k-38654 filename-38655)
+ (let ((fn-38656 (syntax->datum filename-38655)))
+ (let ((tmp-38657
(datum->syntax
- filename-31264
- (let ((t-31269 (%search-load-path fn-31265)))
- (if t-31269
- t-31269
+ filename-38655
+ (let ((t-38660 (%search-load-path fn-38656)))
+ (if t-38660
+ t-38660
(syntax-violation
'include-from-path
"file not found in path"
- x-31257
- filename-31264))))))
+ x-38648
+ filename-38655))))))
(list '#(syntax-object
include
((top)
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-31251"))
+ #(ribcage #(fn) #((top)) #("l-*-38642"))
#(ribcage () () ())
#(ribcage () () ())
- #(ribcage #(fn) #((top)) #("l-*-31247"))
+ #(ribcage #(fn) #((top)) #("l-*-38638"))
#(ribcage
#(k filename)
#((top) (top))
- #("l-*-31243" "l-*-31244"))
+ #("l-*-38634" "l-*-38635"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31240")))
+ #(ribcage #(x) #((top)) #("l-*-38631"))
+ #(ribcage
+ (include-from-path)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ include-from-path
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- tmp-31266))))
- tmp-31259)
+ tmp-38657))))
+ tmp-38650)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-31257))))))
+ x-38648))))))
(define unquote
(make-syntax-transformer
'unquote
'macro
- (lambda (x-31278)
+ (lambda (x-38670)
(syntax-violation
'unquote
"expression not valid outside of quasiquote"
- x-31278))))
+ x-38670))))
(define unquote-splicing
(make-syntax-transformer
'unquote-splicing
'macro
- (lambda (x-31281)
+ (lambda (x-38674)
(syntax-violation
'unquote-splicing
"expression not valid outside of quasiquote"
- x-31281))))
+ x-38674))))
(define case
(make-syntax-transformer
'case
'macro
- (lambda (x-31337)
- (let ((tmp-31339
- ($sc-dispatch x-31337 '(_ any any . each-any))))
- (if tmp-31339
+ (lambda (x-38731)
+ (let ((tmp-38733
+ ($sc-dispatch x-38731 '(_ any any . each-any))))
+ (if tmp-38733
(@apply
- (lambda (e-31343 m1-31344 m2-31345)
- (let ((tmp-31346
+ (lambda (e-38737 m1-38738 m2-38739)
+ (let ((tmp-38740
(letrec*
- ((f-31388
- (lambda (clause-31391 clauses-31392)
- (if (null? clauses-31392)
- (let ((tmp-31394
+ ((f-38794
+ (lambda (clause-38797 clauses-38798)
+ (if (null? clauses-38798)
+ (let ((tmp-38800
($sc-dispatch
- clause-31391
+ clause-38797
'(#(free-id
#(syntax-object
else
@@ -25643,89 +22093,116 @@
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
any
.
each-any))))
- (if tmp-31394
+ (if tmp-38800
(@apply
- (lambda (e1-31398 e2-31399)
+ (lambda (e1-38804 e2-38805)
(cons '#(syntax-object
begin
((top)
#(ribcage
#(e1 e2)
#((top) (top))
- #("l-*-31305" "l-*-31306"))
+ #("l-*-38699" "l-*-38700"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons e1-31398 e2-31399)))
- tmp-31394)
- (let ((tmp-31400
+ (cons e1-38804 e2-38805)))
+ tmp-38800)
+ (let ((tmp-38806
($sc-dispatch
- clause-31391
+ clause-38797
'(each-any any . each-any))))
- (if tmp-31400
+ (if tmp-38806
(@apply
- (lambda (k-31404 e1-31405 e2-31406)
+ (lambda (k-38810 e1-38811 e2-38812)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-31311"
- "l-*-31312"
- "l-*-31313"))
+ #("l-*-38705"
+ "l-*-38706"
+ "l-*-38707"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list '#(syntax-object
memv
@@ -25735,9 +22212,9 @@
#((top)
(top)
(top))
- #("l-*-31311"
- "l-*-31312"
- "l-*-31313"))
+ #("l-*-38705"
+ "l-*-38706"
+ "l-*-38707"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25746,22 +22223,32 @@
#((top)
(top)
(top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
'#(syntax-object
t
@@ -25771,9 +22258,9 @@
#((top)
(top)
(top))
- #("l-*-31311"
- "l-*-31312"
- "l-*-31313"))
+ #("l-*-38705"
+ "l-*-38706"
+ "l-*-38707"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25782,22 +22269,32 @@
#((top)
(top)
(top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
(list '#(syntax-object
quote
@@ -25807,9 +22304,9 @@
#((top)
(top)
(top))
- #("l-*-31311"
- "l-*-31312"
- "l-*-31313"))
+ #("l-*-38705"
+ "l-*-38706"
+ "l-*-38707"))
#(ribcage
()
()
@@ -25821,17 +22318,17 @@
#((top)
(top)
(top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage
()
()
@@ -25839,10 +22336,21 @@
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene
guile))
- k-31404))
+ k-38810))
(cons '#(syntax-object
begin
((top)
@@ -25851,9 +22359,9 @@
#((top)
(top)
(top))
- #("l-*-31311"
- "l-*-31312"
- "l-*-31313"))
+ #("l-*-38705"
+ "l-*-38706"
+ "l-*-38707"))
#(ribcage () () ())
#(ribcage
#(f
@@ -25862,74 +22370,93 @@
#((top)
(top)
(top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- (cons e1-31405
- e2-31406))))
- tmp-31400)
+ (cons e1-38811
+ e2-38812))))
+ tmp-38806)
(syntax-violation
'case
"bad clause"
- x-31337
- clause-31391)))))
- (let ((tmp-31414
- (f-31388
- (car clauses-31392)
- (cdr clauses-31392))))
- (let ((tmp-31417
+ x-38731
+ clause-38797)))))
+ (let ((tmp-38820
+ (f-38794
+ (car clauses-38798)
+ (cdr clauses-38798))))
+ (let ((tmp-38823
($sc-dispatch
- clause-31391
+ clause-38797
'(each-any any . each-any))))
- (if tmp-31417
+ (if tmp-38823
(@apply
- (lambda (k-31421 e1-31422 e2-31423)
+ (lambda (k-38827 e1-38828 e2-38829)
(list '#(syntax-object
if
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-31327"
- "l-*-31328"
- "l-*-31329"))
+ #("l-*-38721"
+ "l-*-38722"
+ "l-*-38723"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-31323"))
+ #("l-*-38717"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list '#(syntax-object
memv
@@ -25937,32 +22464,42 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-31327"
- "l-*-31328"
- "l-*-31329"))
+ #("l-*-38721"
+ "l-*-38722"
+ "l-*-38723"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-31323"))
+ #("l-*-38717"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
'#(syntax-object
t
@@ -25970,32 +22507,42 @@
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-31327"
- "l-*-31328"
- "l-*-31329"))
+ #("l-*-38721"
+ "l-*-38722"
+ "l-*-38723"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-31323"))
+ #("l-*-38717"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
(list '#(syntax-object
quote
@@ -26005,9 +22552,9 @@
#((top)
(top)
(top))
- #("l-*-31327"
- "l-*-31328"
- "l-*-31329"))
+ #("l-*-38721"
+ "l-*-38722"
+ "l-*-38723"))
#(ribcage
()
()
@@ -26015,7 +22562,7 @@
#(ribcage
#(rest)
#((top))
- #("l-*-31323"))
+ #("l-*-38717"))
#(ribcage
()
()
@@ -26027,17 +22574,17 @@
#((top)
(top)
(top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top)
(top)
(top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage
()
()
@@ -26045,63 +22592,93 @@
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene
+ guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- k-31421))
+ k-38827))
(cons '#(syntax-object
begin
((top)
#(ribcage
#(k e1 e2)
#((top) (top) (top))
- #("l-*-31327"
- "l-*-31328"
- "l-*-31329"))
+ #("l-*-38721"
+ "l-*-38722"
+ "l-*-38723"))
#(ribcage () () ())
#(ribcage
#(rest)
#((top))
- #("l-*-31323"))
+ #("l-*-38717"))
#(ribcage () () ())
#(ribcage
#(f clause clauses)
#((top) (top) (top))
- #("l-*-31296"
- "l-*-31297"
- "l-*-31298"))
+ #("l-*-38690"
+ "l-*-38691"
+ "l-*-38692"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31283")))
+ #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- (cons e1-31422 e2-31423))
- tmp-31414))
- tmp-31417)
+ (cons e1-38828 e2-38829))
+ tmp-38820))
+ tmp-38823)
(syntax-violation
'case
"bad clause"
- x-31337
- clause-31391))))))))
- (f-31388 m1-31344 m2-31345))))
- (let ((body-31347 tmp-31346))
+ x-38731
+ clause-38797))))))))
+ (f-38794 m1-38738 m2-38739))))
+ (let ((body-38741 tmp-38740))
(list '#(syntax-object
let
((top)
#(ribcage () () ())
- #(ribcage #(body) #((top)) #("l-*-31294"))
+ #(ribcage #(body) #((top)) #("l-*-38688"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286" "l-*-31287" "l-*-31288"))
+ #("l-*-38680" "l-*-38681" "l-*-38682"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31283")))
+ #(ribcage #(x) #((top)) #("l-*-38677"))
+ #(ribcage
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list (list '#(syntax-object
t
@@ -26110,122 +22687,218 @@
#(ribcage
#(body)
#((top))
- #("l-*-31294"))
+ #("l-*-38688"))
#(ribcage
#(e m1 m2)
#((top) (top) (top))
- #("l-*-31286"
- "l-*-31287"
- "l-*-31288"))
+ #("l-*-38680"
+ "l-*-38681"
+ "l-*-38682"))
#(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-38677"))
#(ribcage
- #(x)
- #((top))
- #("l-*-31283")))
+ (case)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ case
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- e-31343))
- body-31347))))
- tmp-31339)
+ e-38737))
+ body-38741))))
+ tmp-38733)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-31337))))))
+ x-38731))))))
(define make-variable-transformer
- (lambda (proc-31441)
- (if (procedure? proc-31441)
+ (lambda (proc-38848)
+ (if (procedure? proc-38848)
(letrec*
- ((trans-31442
- (lambda (x-31448) (proc-31441 x-31448))))
+ ((trans-38849
+ (lambda (x-38851) (proc-38848 x-38851))))
(begin
(set-procedure-property!
- trans-31442
+ trans-38849
'variable-transformer
#t)
- trans-31442))
+ trans-38849))
(error "variable transformer not a procedure"
- proc-31441))))
+ proc-38848))))
(define identifier-syntax
(make-syntax-transformer
'identifier-syntax
'macro
- (lambda (x-31480)
- (let ((tmp-31482 ($sc-dispatch x-31480 '(_ any))))
- (if tmp-31482
+ (lambda (x-38888)
+ (let ((tmp-38890 ($sc-dispatch x-38888 '(_ any))))
+ (if tmp-38890
(@apply
- (lambda (e-31486)
+ (lambda (e-38894)
(list '#(syntax-object
lambda
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
'#((#(syntax-object
macro-type
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
.
#(syntax-object
identifier-syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))))
(list '#(syntax-object
syntax-case
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'()
(list '#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
identifier?
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(#(syntax-object
syntax
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
id
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))))
(list '#(syntax-object
syntax
@@ -26233,34 +22906,70 @@
#(ribcage
#(e)
#((top))
- #("l-*-31455"))
+ #("l-*-38863"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- e-31486))
+ e-38894))
(list '(#(syntax-object
_
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
x
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
...
((top)
- #(ribcage #(e) #((top)) #("l-*-31455"))
+ #(ribcage #(e) #((top)) #("l-*-38863"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
(list '#(syntax-object
syntax
@@ -26268,26 +22977,44 @@
#(ribcage
#(e)
#((top))
- #("l-*-31455"))
+ #("l-*-38863"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons e-31486
+ (cons e-38894
'(#(syntax-object
x
((top)
#(ribcage
#(e)
#((top))
- #("l-*-31455"))
+ #("l-*-38863"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
...
@@ -26295,59 +23022,86 @@
#(ribcage
#(e)
#((top))
- #("l-*-31455"))
+ #("l-*-38863"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))))))))
- tmp-31482)
- (let ((tmp-31487
+ tmp-38890)
+ (let ((tmp-38895
($sc-dispatch
- x-31480
+ x-38888
'(_ (any any)
((#(free-id
#(syntax-object
set!
((top)
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
any
any)
any)))))
- (if (if tmp-31487
+ (if (if tmp-38895
(@apply
- (lambda (id-31491
- exp1-31492
- var-31493
- val-31494
- exp2-31495)
- (if (identifier? id-31491)
- (identifier? var-31493)
+ (lambda (id-38899
+ exp1-38900
+ var-38901
+ val-38902
+ exp2-38903)
+ (if (identifier? id-38899)
+ (identifier? var-38901)
#f))
- tmp-31487)
+ tmp-38895)
#f)
(@apply
- (lambda (id-31496
- exp1-31497
- var-31498
- val-31499
- exp2-31500)
+ (lambda (id-38904
+ exp1-38905
+ var-38906
+ val-38907
+ exp2-38908)
(list '#(syntax-object
make-variable-transformer
((top)
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list '#(syntax-object
lambda
@@ -26355,13 +23109,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
x
@@ -26369,13 +23132,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
'#((#(syntax-object
macro-type
@@ -26383,13 +23155,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
.
#(syntax-object
@@ -26398,13 +23179,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31452")))
+ #(ribcage #(x) #((top)) #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))))
(list '#(syntax-object
syntax-case
@@ -26412,16 +23202,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-38860"))
#(ribcage
- #(x)
- #((top))
- #("l-*-31452")))
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'#(syntax-object
x
@@ -26429,16 +23225,22 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
+ #(ribcage #(x) #((top)) #("l-*-38860"))
#(ribcage
- #(x)
- #((top))
- #("l-*-31452")))
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
'(#(syntax-object
set!
@@ -26446,16 +23248,25 @@
#(ribcage
#(id exp1 var val exp2)
#((top) (top) (top) (top) (top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile)))
(list (list '#(syntax-object
set!
@@ -26467,19 +23278,28 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- var-31498
- val-31499)
+ var-38906
+ val-38907)
(list '#(syntax-object
syntax
((top)
@@ -26490,19 +23310,28 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- exp2-31500))
- (list (cons id-31496
+ exp2-38908))
+ (list (cons id-38904
'(#(syntax-object
x
((top)
@@ -26513,16 +23342,25 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
#(syntax-object
...
@@ -26534,16 +23372,25 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))))
(list '#(syntax-object
syntax
@@ -26555,18 +23402,27 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons exp1-31497
+ (cons exp1-38905
'(#(syntax-object
x
((top)
@@ -26581,16 +23437,26 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
#(syntax-object
...
@@ -26606,18 +23472,28 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))))))
- (list id-31496
+ (list id-38904
(list '#(syntax-object
identifier?
((top)
@@ -26628,16 +23504,25 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
(list '#(syntax-object
syntax
@@ -26653,18 +23538,28 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene
+ guile))))))
(hygiene guile))
- id-31496))
+ id-38904))
(list '#(syntax-object
syntax
((top)
@@ -26675,69 +23570,96 @@
(top)
(top)
(top))
- #("l-*-31470"
- "l-*-31471"
- "l-*-31472"
- "l-*-31473"
- "l-*-31474"))
+ #("l-*-38878"
+ "l-*-38879"
+ "l-*-38880"
+ "l-*-38881"
+ "l-*-38882"))
#(ribcage () () ())
#(ribcage
#(x)
#((top))
- #("l-*-31452")))
+ #("l-*-38860"))
+ #(ribcage
+ (identifier-syntax)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ identifier-syntax
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- exp1-31497))))))
- tmp-31487)
+ exp1-38905))))))
+ tmp-38895)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-31480))))))))
+ x-38888))))))))
(define define*
(make-syntax-transformer
'define*
'macro
- (lambda (x-31532)
- (let ((tmp-31534
+ (lambda (x-38941)
+ (let ((tmp-38943
($sc-dispatch
- x-31532
+ x-38941
'(_ (any . any) any . each-any))))
- (if tmp-31534
+ (if tmp-38943
(@apply
- (lambda (id-31538 args-31539 b0-31540 b1-31541)
+ (lambda (id-38947 args-38948 b0-38949 b1-38950)
(list '#(syntax-object
define
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-31514"
- "l-*-31515"
- "l-*-31516"
- "l-*-31517"))
+ #("l-*-38923"
+ "l-*-38924"
+ "l-*-38925"
+ "l-*-38926"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31511")))
+ #(ribcage #(x) #((top)) #("l-*-38920"))
+ #(ribcage
+ (define*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- id-31538
+ id-38947
(cons '#(syntax-object
lambda*
((top)
#(ribcage
#(id args b0 b1)
#((top) (top) (top) (top))
- #("l-*-31514"
- "l-*-31515"
- "l-*-31516"
- "l-*-31517"))
+ #("l-*-38923"
+ "l-*-38924"
+ "l-*-38925"
+ "l-*-38926"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31511")))
+ #(ribcage #(x) #((top)) #("l-*-38920"))
+ #(ribcage
+ (define*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- (cons args-31539 (cons b0-31540 b1-31541)))))
- tmp-31534)
- (let ((tmp-31542 ($sc-dispatch x-31532 '(_ any any))))
- (if (if tmp-31542
+ (cons args-38948 (cons b0-38949 b1-38950)))))
+ tmp-38943)
+ (let ((tmp-38951 ($sc-dispatch x-38941 '(_ any any))))
+ (if (if tmp-38951
(@apply
- (lambda (id-31546 val-31547)
+ (lambda (id-38955 val-38956)
(identifier?
'#(syntax-object
x
@@ -26745,29 +23667,47 @@
#(ribcage
#(id val)
#((top) (top))
- #("l-*-31524" "l-*-31525"))
+ #("l-*-38933" "l-*-38934"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31511")))
+ #(ribcage #(x) #((top)) #("l-*-38920"))
+ #(ribcage
+ (define*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))))
- tmp-31542)
+ tmp-38951)
#f)
(@apply
- (lambda (id-31548 val-31549)
+ (lambda (id-38957 val-38958)
(list '#(syntax-object
define
((top)
#(ribcage
#(id val)
#((top) (top))
- #("l-*-31528" "l-*-31529"))
+ #("l-*-38937" "l-*-38938"))
#(ribcage () () ())
- #(ribcage #(x) #((top)) #("l-*-31511")))
+ #(ribcage #(x) #((top)) #("l-*-38920"))
+ #(ribcage
+ (define*)
+ ((top))
+ (((hygiene guile)
+ .
+ #(syntax-object
+ define*
+ ((top))
+ (hygiene guile))))))
(hygiene guile))
- id-31548
- val-31549))
- tmp-31542)
+ id-38957
+ val-38958))
+ tmp-38951)
(syntax-violation
#f
"source expression failed to match any pattern"
- x-31532))))))))
+ x-38941))))))))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 728ab1254..428b583ae 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -316,9 +316,9 @@
(lambda (source)
(make-void source)))
- (define build-application
+ (define build-call
(lambda (source fun-exp arg-exps)
- (make-application source fun-exp arg-exps)))
+ (make-call source fun-exp arg-exps)))
(define build-conditional
(lambda (source test-exp then-exp else-exp)
@@ -405,12 +405,14 @@
(lambda (src req opt rest kw inits vars body else-case)
(make-lambda-case src req opt rest kw inits vars body else-case)))
+ (define build-primcall
+ (lambda (src name args)
+ (make-primcall src name args)))
+
(define build-primref
(lambda (src name)
- (if (equal? (module-name (current-module)) '(guile))
- (make-toplevel-ref src name)
- (make-module-ref src '(guile) name #f))))
-
+ (make-primitive-ref src name)))
+
(define (build-data src exp)
(make-const src exp))
@@ -418,7 +420,7 @@
(lambda (src exps)
(if (null? (cdr exps))
(car exps)
- (make-sequence src exps))))
+ (make-seq src (car exps) (build-sequence #f (cdr exps))))))
(define build-let
(lambda (src ids vars val-exps body-exp)
@@ -439,8 +441,8 @@
(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-call src (build-lexical-reference 'fun src f-name f)
+ val-exps))))))
(define build-letrec
(lambda (src in-order? ids vars val-exps body-exp)
@@ -488,13 +490,14 @@
;; global (assumed global variable) and displaced-lexical (see below)
;; do not show up in any environment; instead, they are fabricated by
- ;; lookup when it finds no other bindings.
+ ;; resolve-identifier when it finds no other bindings.
;; <environment> ::= ((<label> . <binding>)*)
;; identifier bindings include a type and a value
;; <binding> ::= (macro . <procedure>) macros
+ ;; (syntax-parameter . (<procedure>)) syntax parameters
;; (core . <procedure>) core forms
;; (module-ref . <procedure>) @ or @@
;; (begin) begin
@@ -566,22 +569,10 @@
(if (null? r)
'()
(let ((a (car r)))
- (if (eq? (cadr a) 'macro)
+ (if (memq (cadr a) '(macro syntax-parameter))
(cons a (macros-only-env (cdr r)))
(macros-only-env (cdr r)))))))
- (define lookup
- ;; x may be a label or a symbol
- ;; although symbols are usually global, we check the environment first
- ;; anyway because a temporary binding may have been established by
- ;; fluid-let-syntax
- (lambda (x r mod)
- (cond
- ((assq x r) => cdr)
- ((symbol? x)
- (or (get-global-definition-hook x mod) (make-binding 'global)))
- (else (make-binding 'displaced-lexical)))))
-
(define global-extend
(lambda (type sym val)
(put-global-definition-hook sym type val)))
@@ -741,51 +732,86 @@
(same-marks? (cdr x) (cdr y))))))
(define id-var-name
- (lambda (id w)
+ ;; Syntax objects use wraps to associate names with marked
+ ;; identifiers. This function returns the name corresponding to
+ ;; the given identifier and wrap, or the original identifier if no
+ ;; corresponding name was found.
+ ;;
+ ;; The name may be a string created by gen-label, indicating a
+ ;; lexical binding, or another syntax object, indicating a
+ ;; reference to a top-level definition created during a previous
+ ;; macroexpansion.
+ ;;
+ ;; For lexical variables, finding a label simply amounts to
+ ;; looking for an entry with the same symbolic name and the same
+ ;; marks. Finding a toplevel definition is the same, except we
+ ;; also have to compare modules, hence the `mod' parameter.
+ ;; Instead of adding a separate entry in the ribcage for modules,
+ ;; which wouldn't be used for lexicals, we arrange for the entry
+ ;; for the name entry to be a pair with the module in its car, and
+ ;; the name itself in the cdr. So if the name that we find is a
+ ;; pair, we have to check modules.
+ ;;
+ ;; The identifer may be passed in wrapped or unwrapped. In any
+ ;; case, this routine returns either a symbol, a syntax object, or
+ ;; a string label.
+ ;;
+ (lambda (id w mod)
(define-syntax-rule (first e)
;; Rely on Guile's multiple-values truncation.
e)
(define search
- (lambda (sym subst marks)
+ (lambda (sym subst marks mod)
(if (null? subst)
(values #f marks)
(let ((fst (car subst)))
(if (eq? fst 'shift)
- (search sym (cdr subst) (cdr marks))
+ (search sym (cdr subst) (cdr marks) mod)
(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-vector-rib sym subst marks symnames fst mod)
+ (search-list-rib sym subst marks symnames fst mod))))))))
(define search-list-rib
- (lambda (sym subst marks symnames ribcage)
+ (lambda (sym subst marks symnames ribcage mod)
(let f ((symnames symnames) (i 0))
(cond
- ((null? symnames) (search sym (cdr subst) marks))
+ ((null? symnames) (search sym (cdr subst) marks mod))
((and (eq? (car symnames) sym)
(same-marks? marks (list-ref (ribcage-marks ribcage) i)))
- (values (list-ref (ribcage-labels ribcage) i) marks))
+ (let ((n (list-ref (ribcage-labels ribcage) i)))
+ (if (pair? n)
+ (if (equal? mod (car n))
+ (values (cdr n) marks)
+ (f (cdr symnames) (fx+ i 1)))
+ (values n marks))))
(else (f (cdr symnames) (fx+ i 1)))))))
(define search-vector-rib
- (lambda (sym subst marks symnames ribcage)
+ (lambda (sym subst marks symnames ribcage mod)
(let ((n (vector-length symnames)))
(let f ((i 0))
(cond
- ((fx= i n) (search sym (cdr subst) marks))
+ ((fx= i n) (search sym (cdr subst) marks mod))
((and (eq? (vector-ref symnames i) sym)
(same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
- (values (vector-ref (ribcage-labels ribcage) i) marks))
+ (let ((n (vector-ref (ribcage-labels ribcage) i)))
+ (if (pair? n)
+ (if (equal? mod (car n))
+ (values (cdr n) marks)
+ (f (fx+ i 1)))
+ (values n marks))))
(else (f (fx+ i 1))))))))
(cond
((symbol? id)
- (or (first (search id (wrap-subst w) (wrap-marks w))) id))
+ (or (first (search id (wrap-subst w) (wrap-marks w) mod)) id))
((syntax-object? id)
(let ((id (syntax-object-expression id))
- (w1 (syntax-object-wrap id)))
+ (w1 (syntax-object-wrap id))
+ (mod (syntax-object-module id)))
(let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
- (call-with-values (lambda () (search id (wrap-subst w) marks))
+ (call-with-values (lambda () (search id (wrap-subst w) marks mod))
(lambda (new-id marks)
(or new-id
- (first (search id (wrap-subst w1) marks))
+ (first (search id (wrap-subst w1) marks mod))
id))))))
(else (syntax-violation 'id-var-name "invalid id" id)))))
@@ -840,19 +866,31 @@
;; Returns three values: binding type, binding value, the module (for
;; resolving toplevel vars).
- (define (resolve-identifier id w r mod)
+ (define (resolve-identifier id w r mod resolve-syntax-parameters?)
+ (define (resolve-syntax-parameters b)
+ (if (and resolve-syntax-parameters?
+ (eq? (binding-type b) 'syntax-parameter))
+ (or (assq-ref r (binding-value b))
+ (make-binding 'macro (car (binding-value b))))
+ b))
(define (resolve-global var mod)
- (let ((b (or (get-global-definition-hook var mod)
- (make-binding 'global))))
+ (let ((b (resolve-syntax-parameters
+ (or (get-global-definition-hook var mod)
+ (make-binding 'global)))))
(if (eq? (binding-type b) 'global)
(values 'global var mod)
(values (binding-type b) (binding-value b) mod))))
(define (resolve-lexical label mod)
- (let ((b (or (assq-ref r label)
- (make-binding 'displaced-lexical))))
+ (let ((b (resolve-syntax-parameters
+ (or (assq-ref r label)
+ (make-binding 'displaced-lexical)))))
(values (binding-type b) (binding-value b) mod)))
- (let ((n (id-var-name id w)))
+ (let ((n (id-var-name id w mod)))
(cond
+ ((syntax-object? n)
+ ;; Recursing allows syntax-parameterize to override
+ ;; macro-introduced syntax parameters.
+ (resolve-identifier n w r mod resolve-syntax-parameters?))
((symbol? n)
(resolve-global n (if (syntax-object? id)
(syntax-object-module id)
@@ -877,9 +915,39 @@
(define free-id=?
(lambda (i j)
- (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
- (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
-
+ (let* ((mi (and (syntax-object? i) (syntax-object-module i)))
+ (mj (and (syntax-object? j) (syntax-object-module j)))
+ (ni (id-var-name i empty-wrap mi))
+ (nj (id-var-name j empty-wrap mj)))
+ (define (id-module-binding id mod)
+ (module-variable
+ (if mod
+ ;; The normal case.
+ (resolve-module (cdr mod))
+ ;; Either modules have not been booted, or we have a
+ ;; raw symbol coming in, which is possible.
+ (current-module))
+ (id-sym-name id)))
+ (cond
+ ((syntax-object? ni) (free-id=? ni j))
+ ((syntax-object? nj) (free-id=? i nj))
+ ((symbol? ni)
+ ;; `i' is not lexically bound. Assert that `j' is free,
+ ;; and if so, compare their bindings, that they are either
+ ;; bound to the same variable, or both unbound and have
+ ;; the same name.
+ (and (eq? nj (id-sym-name j))
+ (let ((bi (id-module-binding i mi)))
+ (if bi
+ (eq? bi (id-module-binding j mj))
+ (and (not (id-module-binding j mj))
+ (eq? ni nj))))
+ (eq? (id-module-binding i mi) (id-module-binding j mj))))
+ (else
+ ;; Otherwise `i' is bound, so check that `j' is bound, and
+ ;; bound to the same thing.
+ (equal? ni nj))))))
+
;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
;; long as the missing portion of the wrap is common to both of the ids
;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
@@ -970,161 +1038,171 @@
;;
(define expand-top-sequence
(lambda (body r w s m esew mod)
- (define (scan body r w s m esew mod exps)
- (cond
- ((null? body)
- ;; in reversed order
- exps)
- (else
+ (let* ((r (cons '("placeholder" . (placeholder)) r))
+ (ribcage (make-empty-ribcage))
+ (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))))
+ (define (record-definition! id var)
+ (let ((mod (cons 'hygiene (module-name (current-module)))))
+ ;; Ribcages map symbol+marks to names, mostly for
+ ;; resolving lexicals. Here to add a mapping for toplevel
+ ;; definitions we also need to match the module. So, we
+ ;; put it in the name instead, and make id-var-name handle
+ ;; the special case of names that are pairs. See the
+ ;; comments in id-var-name for more.
+ (extend-ribcage! ribcage id
+ (cons (syntax-object-module id)
+ (wrap var top-wrap mod)))))
+ (define (macro-introduced-identifier? id)
+ (not (equal? (wrap-marks (syntax-object-wrap id)) '(top))))
+ (define (fresh-derived-name id orig-form)
+ (symbol-append
+ (syntax-object-expression id)
+ '-
+ (string->symbol
+ ;; FIXME: `hash' currently stops descending into nested
+ ;; data at some point, so it's less unique than we would
+ ;; like. Also this encodes hash values into the ABI of
+ ;; compiled modules; a problem?
+ (number->string
+ (hash (syntax->datum orig-form) most-positive-fixnum)
+ 16))))
+ (define (parse body r w s m esew mod)
+ (let lp ((body body) (exps '()))
+ (if (null? body)
+ exps
+ (lp (cdr body)
+ (append (parse1 (car body) r w s m esew mod)
+ exps)))))
+ (define (parse1 x r w s m esew mod)
(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)
- (case type
- ((begin-form)
- (syntax-case e ()
- ((_) exps)
- ((_ e1 e2 ...)
- (scan #'(e1 e2 ...) r w s m esew mod exps))))
- ((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))))
- ((eval-when-form)
- (syntax-case e ()
- ((_ (x ...) e1 e2 ...)
- (let ((when-list (parse-when-list e #'(x ...)))
- (body #'(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)
- (if (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)
- (if (memq m '(c c&e))
- (scan body r w s 'c '(load) mod exps)
- (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)))))))
- ((define-syntax-form define-syntax-parameter-form)
- (let ((n (id-var-name value w)) (r (macros-only-env r)))
- (case m
- ((c)
- (if (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)))
- (if (memq 'load esew)
- (values (cons (expand-install-global n (expand e r w mod))
- exps))
- (values exps))))
- ((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)))))
- ((define-form)
- (let* ((n (id-var-name value w))
- ;; Lookup the name in the module of the define form.
- (type (binding-type (lookup n r mod))))
- (case type
- ((global core macro module-ref)
- ;; affect compile-time environment (once we have booted)
- (if (and (memq m '(c c&e))
- (not (module-local-variable (current-module) n))
- (current-module))
- (let ((old (module-variable (current-module) n)))
- ;; use value of the same-named imported variable, if
- ;; any
- (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)))
- ((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 ()
- (scan body r w s m esew mod '()))
- (lambda (exps)
+ (syntax-type x r w (source-annotation x) ribcage mod #f))
+ (lambda (type value form e w s mod)
+ (case type
+ ((define-form)
+ (let* ((id (wrap value w mod))
+ (label (gen-label))
+ (var (if (macro-introduced-identifier? id)
+ (fresh-derived-name id x)
+ (syntax-object-expression id))))
+ (record-definition! id var)
+ (list
+ (if (eq? m 'c&e)
+ (let ((x (build-global-definition s var (expand e r w mod))))
+ (top-level-eval-hook x mod)
+ (lambda () x))
+ (lambda ()
+ (build-global-definition s var (expand e r w mod)))))))
+ ((define-syntax-form define-syntax-parameter-form)
+ (let* ((id (wrap value w mod))
+ (label (gen-label))
+ (var (if (macro-introduced-identifier? id)
+ (fresh-derived-name id x)
+ (syntax-object-expression id))))
+ (record-definition! id var)
+ (case m
+ ((c)
+ (cond
+ ((memq 'compile esew)
+ (let ((e (expand-install-global var type (expand e r w mod))))
+ (top-level-eval-hook e mod)
+ (if (memq 'load esew)
+ (list (lambda () e))
+ '())))
+ ((memq 'load esew)
+ (list (lambda ()
+ (expand-install-global var type (expand e r w mod)))))
+ (else '())))
+ ((c&e)
+ (let ((e (expand-install-global var type (expand e r w mod))))
+ (top-level-eval-hook e mod)
+ (list (lambda () e))))
+ (else
+ (if (memq 'eval esew)
+ (top-level-eval-hook
+ (expand-install-global var type (expand e r w mod))
+ mod))
+ '()))))
+ ((begin-form)
+ (syntax-case e ()
+ ((_ e1 ...)
+ (parse #'(e1 ...) r w s m esew mod))))
+ ((local-syntax-form)
+ (expand-local-syntax value e r w s mod
+ (lambda (forms r w s mod)
+ (parse forms r w s m esew mod))))
+ ((eval-when-form)
+ (syntax-case e ()
+ ((_ (x ...) e1 e2 ...)
+ (let ((when-list (parse-when-list e #'(x ...)))
+ (body #'(e1 e2 ...)))
+ (define (recurse m esew)
+ (parse body r w s m esew mod))
+ (cond
+ ((eq? m 'e)
+ (if (memq 'eval when-list)
+ (recurse (if (memq 'expand when-list) 'c&e 'e)
+ '(eval))
+ (begin
+ (if (memq 'expand when-list)
+ (top-level-eval-hook
+ (expand-top-sequence body r w s 'e '(eval) mod)
+ mod))
+ '())))
+ ((memq 'load when-list)
+ (if (or (memq 'compile when-list)
+ (memq 'expand when-list)
+ (and (eq? m 'c&e) (memq 'eval when-list)))
+ (recurse 'c&e '(compile load))
+ (if (memq m '(c c&e))
+ (recurse 'c '(load))
+ '())))
+ ((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)
+ '())
+ (else
+ '()))))))
+ (else
+ (list
+ (if (eq? m 'c&e)
+ (let ((x (expand-expr type value form e r w s mod)))
+ (top-level-eval-hook x mod)
+ (lambda () x))
+ (lambda ()
+ (expand-expr type value form e r w s mod)))))))))
+ (let ((exps (map (lambda (x) (x))
+ (reverse (parse body r w s m esew mod)))))
(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)))))))))))
+ (build-sequence s exps))))))
(define expand-install-global
- (lambda (name e)
+ (lambda (name type e)
(build-global-definition
no-source
name
- (build-application
+ (build-primcall
no-source
- (build-primref no-source 'make-syntax-transformer)
- (list (build-data no-source name)
- (build-data no-source 'macro)
- e)))))
-
+ 'make-syntax-transformer
+ (if (eq? type 'define-syntax-parameter-form)
+ (list (build-data no-source name)
+ (build-data no-source 'syntax-parameter)
+ (build-primcall no-source 'list (list e)))
+ (list (build-data no-source name)
+ (build-data no-source 'macro)
+ e))))))
+
(define parse-when-list
(lambda (e when-list)
- ;; when-list is syntax'd version of list of situations
+ ;; `when-list' is syntax'd version of list of situations. We
+ ;; could match these keywords lexically, via free-id=?, but then
+ ;; we twingle the definition of eval-when to the bindings of
+ ;; eval, load, expand, and compile, which is totally unintended.
+ ;; So do a symbolic match instead.
(let ((result (strip when-list empty-wrap)))
(let lp ((l result))
(if (null? l)
@@ -1178,18 +1256,19 @@
(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 (binding-type b)))
- (case type
- ((lexical) (values type (binding-value b) e e w s mod))
- ((global) (values type n e e w s mod))
- ((macro)
- (if for-car?
- (values type (binding-value b) e e w s mod)
- (syntax-type (expand-macro (binding-value b) e r w s rib mod)
- r empty-wrap s rib mod #f)))
- (else (values type (binding-value b) e e w s mod)))))
+ (call-with-values (lambda () (resolve-identifier e w r mod #t))
+ (lambda (type value mod*)
+ (case type
+ ((macro)
+ (if for-car?
+ (values type value e e w s mod)
+ (syntax-type (expand-macro value e r w s rib mod)
+ r empty-wrap s rib mod #f)))
+ ((global)
+ ;; Toplevel definitions may resolve to bindings with
+ ;; different names or in different modules.
+ (values type value e value w s mod*))
+ (else (values type value e e w s mod))))))
((pair? e)
(let ((first (car e)))
(call-with-values
@@ -1281,7 +1360,7 @@
(lambda (e r w s mod)
(expand e r w mod))))
((lexical-call)
- (expand-application
+ (expand-call
(let ((id (car e)))
(build-lexical-reference 'fun (source-annotation id)
(if (syntax-object? id)
@@ -1290,7 +1369,7 @@
value))
e r w s mod))
((global-call)
- (expand-application
+ (expand-call
(build-global-reference (source-annotation (car e))
(if (syntax-object? value)
(syntax-object-expression value)
@@ -1301,18 +1380,13 @@
e r w s mod))
((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
((global) (build-global-reference s value mod))
- ((call) (expand-application (expand (car e) r w mod) e r w s mod))
+ ((call) (expand-call (expand (car e) r w mod) e r w s mod))
((begin-form)
(syntax-case e ()
((_ e1 e2 ...) (expand-sequence #'(e1 e2 ...) r w s mod))
((_)
- (if (include-deprecated-features)
- (begin
- (issue-deprecation-warning
- "Sequences of zero expressions are deprecated. Use *unspecified*.")
- (expand-void))
- (syntax-violation #f "sequence of zero expressions"
- (source-wrap e w s mod))))))
+ (syntax-violation #f "sequence of zero expressions"
+ (source-wrap e w s mod)))))
((local-syntax-form)
(expand-local-syntax value e r w s mod expand-sequence))
((eval-when-form)
@@ -1334,12 +1408,12 @@
(else (syntax-violation #f "unexpected syntax"
(source-wrap e w s mod))))))
- (define expand-application
+ (define expand-call
(lambda (x e r w s mod)
(syntax-case e ()
((e0 e1 ...)
- (build-application s x
- (map (lambda (e) (expand e r w mod)) #'(e1 ...)))))))
+ (build-call s x
+ (map (lambda (e) (expand e r w mod)) #'(e1 ...)))))))
;; (What follows is my interpretation of what's going on here -- Andy)
;;
@@ -1364,7 +1438,7 @@
;;
;; The only wrinkle is when we want a macro to expand to code in another
;; module, as is the case for the r6rs `library' form -- the body expressions
- ;; should be scoped relative the new module, the one defined by the macro.
+ ;; should be scoped relative the the new module, the one defined by the macro.
;; For that, use `(@@ mod-name body)'.
;;
;; Part of the macro output will be from the site of the macro use and part
@@ -1485,7 +1559,11 @@
(parse (cdr body)
(cons id ids) (cons label labels)
var-ids vars vals
- (cons (make-binding 'macro (cons er (wrap e w mod)))
+ (cons (make-binding
+ (if (eq? type 'define-syntax-parameter-form)
+ 'syntax-parameter
+ 'macro)
+ (cons er (wrap e w mod)))
bindings))))
((begin-form)
(syntax-case e ()
@@ -1520,7 +1598,7 @@
(let loop ((bs bindings) (er-cache #f) (r-cache #f))
(if (not (null? bs))
(let* ((b (car bs)))
- (if (eq? (car b) 'macro)
+ (if (memq (car b) '(macro syntax-parameter))
(let* ((er (cadr b))
(r-cache
(if (eq? er er-cache)
@@ -1530,6 +1608,8 @@
(eval-local-transformer
(expand (cddr b) r-cache empty-wrap mod)
mod))
+ (if (eq? (car b) 'syntax-parameter)
+ (set-cdr! b (list (cdr b))))
(loop (cdr bs) er r-cache))
(loop (cdr bs) er-cache r-cache)))))
(set-cdr! r (extend-env labels bindings (cdr r)))
@@ -1856,38 +1936,45 @@
(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)
- (syntax-case e ()
- ((_ ((var val) ...) e1 e2 ...)
- (valid-bound-ids? #'(var ...))
- (let ((names (map (lambda (x) (id-var-name x w)) #'(var ...))))
- (for-each
- (lambda (id n)
- (case (binding-type (lookup n r mod))
- ((displaced-lexical)
- (syntax-violation 'syntax-parameterize
- "identifier out of context"
- e
- (source-wrap id w s mod)))))
- #'(var ...)
- names)
- (expand-body
- #'(e1 e2 ...)
- (source-wrap e w s mod)
- (extend-env
- names
- (let ((trans-r (macros-only-env r)))
- (map (lambda (x)
- (make-binding 'macro
- (eval-local-transformer (expand x trans-r w mod)
- mod)))
- #'(val ...)))
- r)
- w
- mod)))
- (_ (syntax-violation 'syntax-parameterize "bad syntax"
- (source-wrap e w s mod))))))
+ (global-extend
+ 'core 'syntax-parameterize
+ (lambda (e r w s mod)
+ (syntax-case e ()
+ ((_ ((var val) ...) e1 e2 ...)
+ (valid-bound-ids? #'(var ...))
+ (let ((names
+ (map (lambda (x)
+ (call-with-values
+ (lambda () (resolve-identifier x w r mod #f))
+ (lambda (type value mod)
+ (case type
+ ((displaced-lexical)
+ (syntax-violation 'syntax-parameterize
+ "identifier out of context"
+ e
+ (source-wrap x w s mod)))
+ ((syntax-parameter)
+ value)
+ (else
+ (syntax-violation 'syntax-parameterize
+ "invalid syntax parameter"
+ e
+ (source-wrap x w s mod)))))))
+ #'(var ...)))
+ (bindings
+ (let ((trans-r (macros-only-env r)))
+ (map (lambda (x)
+ (make-binding
+ 'macro
+ (eval-local-transformer (expand x trans-r w mod) mod)))
+ #'(val ...)))))
+ (expand-body #'(e1 e2 ...)
+ (source-wrap e w s mod)
+ (extend-env names bindings r)
+ w
+ mod)))
+ (_ (syntax-violation 'syntax-parameterize "bad syntax"
+ (source-wrap e w s mod))))))
(global-extend 'core 'quote
(lambda (e r w s mod)
@@ -1896,167 +1983,166 @@
(_ (syntax-violation 'quote "bad syntax"
(source-wrap e w s mod))))))
- (global-extend 'core 'syntax
- (let ()
- (define gen-syntax
- (lambda (src e r maps ellipsis? mod)
- (if (id? e)
- (let ((label (id-var-name e empty-wrap)))
- ;; Mod does not matter, we are looking to see if
- ;; the id is lexical syntax.
- (let ((b (lookup label r mod)))
- (if (eq? (binding-type b) 'syntax)
- (call-with-values
- (lambda ()
- (let ((var.lev (binding-value b)))
- (gen-ref src (car var.lev) (cdr var.lev) maps)))
- (lambda (var maps) (values `(ref ,var) maps)))
- (if (ellipsis? e)
- (syntax-violation 'syntax "misplaced ellipsis" src)
- (values `(quote ,e) maps)))))
- (syntax-case e ()
- ((dots e)
- (ellipsis? #'dots)
- (gen-syntax src #'e r maps (lambda (x) #f) mod))
- ((x dots . y)
- ;; this could be about a dozen lines of code, except that we
- ;; choose to handle #'(x ... ...) forms
- (ellipsis? #'dots)
- (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))))))))
- (syntax-case y ()
- ((dots . y)
- (ellipsis? #'dots)
- (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))))))))
- (_ (call-with-values
- (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)))))))))
- ((x . y)
- (call-with-values
- (lambda () (gen-syntax src #'x r maps ellipsis? mod))
- (lambda (x maps)
- (call-with-values
- (lambda () (gen-syntax src #'y r maps ellipsis? mod))
- (lambda (y maps) (values (gen-cons x y) maps))))))
- (#(e1 e2 ...)
- (call-with-values
- (lambda ()
- (gen-syntax src #'(e1 e2 ...) r maps ellipsis? mod))
- (lambda (e maps) (values (gen-vector e) maps))))
- (_ (values `(quote ,e) maps))))))
-
- (define gen-ref
- (lambda (src var level maps)
- (if (fx= level 0)
- (values var maps)
- (if (null? maps)
- (syntax-violation 'syntax "missing ellipsis" src)
- (call-with-values
- (lambda () (gen-ref src var (fx- 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)))))))))))
-
- (define gen-mappend
- (lambda (e map-env)
- `(apply (primitive append) ,(gen-map e map-env))))
-
- (define gen-map
- (lambda (e map-env)
- (let ((formals (map cdr map-env))
- (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
- (cond
- ((eq? (car e) 'ref)
- ;; identity map equivalence:
- ;; (map (lambda (x) x) y) == y
- (car actuals))
- ((and-map
- (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
- (cdr e))
- ;; eta map equivalence:
- ;; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
- `(map (primitive ,(car e))
- ,@(map (let ((r (map cons formals actuals)))
- (lambda (x) (cdr (assq (cadr x) r))))
- (cdr e))))
- (else `(map (lambda ,formals ,e) ,@actuals))))))
-
- (define gen-cons
- (lambda (x y)
- (case (car y)
- ((quote)
- (if (eq? (car x) 'quote)
- `(quote (,(cadr x) . ,(cadr y)))
- (if (eq? (cadr y) '())
- `(list ,x)
- `(cons ,x ,y))))
- ((list) `(list ,x ,@(cdr y)))
- (else `(cons ,x ,y)))))
-
- (define gen-append
- (lambda (x y)
- (if (equal? y '(quote ()))
- x
- `(append ,x ,y))))
-
- (define gen-vector
- (lambda (x)
- (cond
- ((eq? (car x) 'list) `(vector ,@(cdr x)))
- ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
- (else `(list->vector ,x)))))
-
-
- (define regen
- (lambda (x)
- (case (car x)
- ((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
- ((primitive) (build-primref no-source (cadr x)))
- ((quote) (build-data no-source (cadr x)))
- ((lambda)
- (if (list? (cadr x))
- (build-simple-lambda no-source (cadr x) #f (cadr x) '() (regen (caddr x)))
- (error "how did we get here" x)))
- (else (build-application no-source
- (build-primref no-source (car x))
- (map regen (cdr x)))))))
-
- (lambda (e r w s mod)
- (let ((e (source-wrap e w s mod)))
- (syntax-case e ()
- ((_ x)
+ (global-extend
+ 'core 'syntax
+ (let ()
+ (define gen-syntax
+ (lambda (src e r maps ellipsis? mod)
+ (if (id? e)
+ (call-with-values (lambda ()
+ (resolve-identifier e empty-wrap r mod #f))
+ (lambda (type value mod)
+ (case type
+ ((syntax)
+ (call-with-values
+ (lambda () (gen-ref src (car value) (cdr value) maps))
+ (lambda (var maps)
+ (values `(ref ,var) maps))))
+ (else
+ (if (ellipsis? e)
+ (syntax-violation 'syntax "misplaced ellipsis" src)
+ (values `(quote ,e) maps))))))
+ (syntax-case e ()
+ ((dots e)
+ (ellipsis? #'dots)
+ (gen-syntax src #'e r maps (lambda (x) #f) mod))
+ ((x dots . y)
+ ;; this could be about a dozen lines of code, except that we
+ ;; choose to handle #'(x ... ...) forms
+ (ellipsis? #'dots)
+ (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))))))))
+ (syntax-case y ()
+ ((dots . y)
+ (ellipsis? #'dots)
+ (f #'y
+ (lambda (maps)
(call-with-values
- (lambda () (gen-syntax e #'x r '() ellipsis? mod))
- (lambda (e maps) (regen e))))
- (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
+ (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))))))))
+ (_ (call-with-values
+ (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)))))))))
+ ((x . y)
+ (call-with-values
+ (lambda () (gen-syntax src #'x r maps ellipsis? mod))
+ (lambda (x maps)
+ (call-with-values
+ (lambda () (gen-syntax src #'y r maps ellipsis? mod))
+ (lambda (y maps) (values (gen-cons x y) maps))))))
+ (#(e1 e2 ...)
+ (call-with-values
+ (lambda ()
+ (gen-syntax src #'(e1 e2 ...) r maps ellipsis? mod))
+ (lambda (e maps) (values (gen-vector e) maps))))
+ (_ (values `(quote ,e) maps))))))
+
+ (define gen-ref
+ (lambda (src var level maps)
+ (if (fx= level 0)
+ (values var maps)
+ (if (null? maps)
+ (syntax-violation 'syntax "missing ellipsis" src)
+ (call-with-values
+ (lambda () (gen-ref src var (fx- 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)))))))))))
+
+ (define gen-mappend
+ (lambda (e map-env)
+ `(apply (primitive append) ,(gen-map e map-env))))
+
+ (define gen-map
+ (lambda (e map-env)
+ (let ((formals (map cdr map-env))
+ (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
+ (cond
+ ((eq? (car e) 'ref)
+ ;; identity map equivalence:
+ ;; (map (lambda (x) x) y) == y
+ (car actuals))
+ ((and-map
+ (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
+ (cdr e))
+ ;; eta map equivalence:
+ ;; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
+ `(map (primitive ,(car e))
+ ,@(map (let ((r (map cons formals actuals)))
+ (lambda (x) (cdr (assq (cadr x) r))))
+ (cdr e))))
+ (else `(map (lambda ,formals ,e) ,@actuals))))))
+
+ (define gen-cons
+ (lambda (x y)
+ (case (car y)
+ ((quote)
+ (if (eq? (car x) 'quote)
+ `(quote (,(cadr x) . ,(cadr y)))
+ (if (eq? (cadr y) '())
+ `(list ,x)
+ `(cons ,x ,y))))
+ ((list) `(list ,x ,@(cdr y)))
+ (else `(cons ,x ,y)))))
+
+ (define gen-append
+ (lambda (x y)
+ (if (equal? y '(quote ()))
+ x
+ `(append ,x ,y))))
+
+ (define gen-vector
+ (lambda (x)
+ (cond
+ ((eq? (car x) 'list) `(vector ,@(cdr x)))
+ ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
+ (else `(list->vector ,x)))))
+
+
+ (define regen
+ (lambda (x)
+ (case (car x)
+ ((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
+ ((primitive) (build-primref no-source (cadr x)))
+ ((quote) (build-data no-source (cadr x)))
+ ((lambda)
+ (if (list? (cadr x))
+ (build-simple-lambda no-source (cadr x) #f (cadr x) '() (regen (caddr x)))
+ (error "how did we get here" x)))
+ (else (build-primcall no-source (car x) (map regen (cdr x)))))))
+
+ (lambda (e r w s mod)
+ (let ((e (source-wrap e w s mod)))
+ (syntax-case e ()
+ ((_ x)
+ (call-with-values
+ (lambda () (gen-syntax e #'x r '() ellipsis? mod))
+ (lambda (e maps) (regen e))))
+ (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
(global-extend 'core 'lambda
(lambda (e r w s mod)
@@ -2191,58 +2277,53 @@
(_ (syntax-violation 'letrec* "bad letrec*" (source-wrap e w s mod))))))
- (global-extend 'core 'set!
- (lambda (e r w s mod)
- (syntax-case e ()
- ((_ id val)
- (id? #'id)
- (let ((n (id-var-name #'id w))
- ;; Lookup id in its module
- (id-mod (if (syntax-object? #'id)
- (syntax-object-module #'id)
- mod)))
- (let ((b (lookup n r id-mod)))
- (case (binding-type b)
- ((lexical)
- (build-lexical-assignment s
- (syntax->datum #'id)
- (binding-value b)
- (expand #'val r w mod)))
- ((global)
- (build-global-assignment s n (expand #'val r w mod) id-mod))
- ((macro)
- (let ((p (binding-value b)))
- (if (procedure-property p 'variable-transformer)
- ;; As syntax-type does, call expand-macro with
- ;; the mod of the expression. Hmm.
- (expand (expand-macro p e r w s #f mod) r empty-wrap mod)
- (syntax-violation 'set! "not a variable transformer"
- (wrap e w mod)
- (wrap #'id w id-mod)))))
- ((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)))))))
- ((_ (head tail ...) val)
- (call-with-values
- (lambda () (syntax-type #'head r empty-wrap no-source #f mod #t))
- (lambda (type value formform ee ww ss modmod)
- (case type
- ((module-ref)
- (let ((val (expand #'val r w mod)))
- (call-with-values (lambda () (value #'(head tail ...) r w))
- (lambda (e r w s* mod)
- (syntax-case e ()
- (e (id? #'e)
- (build-global-assignment s (syntax->datum #'e)
- val mod)))))))
- (else
- (build-application s
- (expand #'(setter head) r w mod)
- (map (lambda (e) (expand e r w mod))
- #'(tail ... val))))))))
- (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
+ (global-extend
+ 'core 'set!
+ (lambda (e r w s mod)
+ (syntax-case e ()
+ ((_ id val)
+ (id? #'id)
+ (call-with-values
+ (lambda () (resolve-identifier #'id w r mod #t))
+ (lambda (type value id-mod)
+ (case type
+ ((lexical)
+ (build-lexical-assignment s (syntax->datum #'id) value
+ (expand #'val r w mod)))
+ ((global)
+ (build-global-assignment s value (expand #'val r w mod) id-mod))
+ ((macro)
+ (if (procedure-property value 'variable-transformer)
+ ;; As syntax-type does, call expand-macro with
+ ;; the mod of the expression. Hmm.
+ (expand (expand-macro value e r w s #f mod) r empty-wrap mod)
+ (syntax-violation 'set! "not a variable transformer"
+ (wrap e w mod)
+ (wrap #'id w id-mod))))
+ ((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)))))))
+ ((_ (head tail ...) val)
+ (call-with-values
+ (lambda () (syntax-type #'head r empty-wrap no-source #f mod #t))
+ (lambda (type value ee* ee ww ss modmod)
+ (case type
+ ((module-ref)
+ (let ((val (expand #'val r w mod)))
+ (call-with-values (lambda () (value #'(head tail ...) r w))
+ (lambda (e r w s* mod)
+ (syntax-case e ()
+ (e (id? #'e)
+ (build-global-assignment s (syntax->datum #'e)
+ val mod)))))))
+ (else
+ (build-call s
+ (expand #'(setter head) r w mod)
+ (map (lambda (e) (expand e r w mod))
+ #'(tail ... val))))))))
+ (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
(global-extend 'module-ref '@
(lambda (e r w)
@@ -2391,20 +2472,21 @@
(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 no-source
- (build-primref no-source 'apply)
- (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '()
- (expand exp
- (extend-env
- labels
- (map (lambda (var level)
- (make-binding 'syntax `(,var . ,level)))
- new-vars
- (map cdr pvars))
- r)
- (make-binding-wrap ids labels empty-wrap)
- mod))
- y))))))
+ (build-primcall
+ no-source
+ 'apply
+ (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars '()
+ (expand exp
+ (extend-env
+ labels
+ (map (lambda (var level)
+ (make-binding 'syntax `(,var . ,level)))
+ new-vars
+ (map cdr pvars))
+ r)
+ (make-binding-wrap ids labels empty-wrap)
+ mod))
+ y))))))
(define gen-clause
(lambda (x keys clauses r pat fender exp mod)
@@ -2419,36 +2501,32 @@
(else
(let ((y (gen-var 'tmp)))
;; fat finger binding and references to temp variable y
- (build-application no-source
- (build-simple-lambda no-source (list 'tmp) #f (list y) '()
- (let ((y (build-lexical-reference 'value no-source
- 'tmp y)))
- (build-conditional no-source
- (syntax-case fender ()
- (#t y)
- (_ (build-conditional no-source
- y
- (build-dispatch-call pvars fender y r mod)
- (build-data no-source #f))))
- (build-dispatch-call pvars exp y r mod)
- (gen-syntax-case x keys clauses r mod))))
- (list (if (eq? p 'any)
- (build-application no-source
- (build-primref no-source 'list)
- (list x))
- (build-application no-source
- (build-primref no-source '$sc-dispatch)
- (list x (build-data no-source p)))))))))))))
+ (build-call no-source
+ (build-simple-lambda no-source (list 'tmp) #f (list y) '()
+ (let ((y (build-lexical-reference 'value no-source
+ 'tmp y)))
+ (build-conditional no-source
+ (syntax-case fender ()
+ (#t y)
+ (_ (build-conditional no-source
+ y
+ (build-dispatch-call pvars fender y r mod)
+ (build-data no-source #f))))
+ (build-dispatch-call pvars exp y r mod)
+ (gen-syntax-case x keys clauses r mod))))
+ (list (if (eq? p 'any)
+ (build-primcall no-source 'list (list x))
+ (build-primcall no-source '$sc-dispatch
+ (list x (build-data no-source p)))))))))))))
(define gen-syntax-case
(lambda (x keys clauses r mod)
(if (null? clauses)
- (build-application no-source
- (build-primref no-source 'syntax-violation)
- (list (build-data no-source #f)
- (build-data no-source
- "source expression failed to match any pattern")
- x))
+ (build-primcall no-source 'syntax-violation
+ (list (build-data no-source #f)
+ (build-data no-source
+ "source expression failed to match any pattern")
+ x))
(syntax-case (car clauses) ()
((pat exp)
(if (and (id? #'pat)
@@ -2458,18 +2536,18 @@
(expand #'exp r empty-wrap mod)
(let ((labels (list (gen-label)))
(var (gen-var #'pat)))
- (build-application no-source
- (build-simple-lambda
- no-source (list (syntax->datum #'pat)) #f (list var)
- '()
- (expand #'exp
- (extend-env labels
- (list (make-binding 'syntax `(,var . 0)))
- r)
- (make-binding-wrap #'(pat)
- labels empty-wrap)
- mod))
- (list x))))
+ (build-call no-source
+ (build-simple-lambda
+ no-source (list (syntax->datum #'pat)) #f (list var)
+ '()
+ (expand #'exp
+ (extend-env labels
+ (list (make-binding 'syntax `(,var . 0)))
+ r)
+ (make-binding-wrap #'(pat)
+ labels empty-wrap)
+ mod))
+ (list x))))
(gen-clause x keys (cdr clauses) r
#'pat #t #'exp mod)))
((pat fender exp)
@@ -2486,14 +2564,14 @@
#'(key ...))
(let ((x (gen-var 'tmp)))
;; fat finger binding and references to temp variable x
- (build-application s
- (build-simple-lambda no-source (list 'tmp) #f (list x) '()
- (gen-syntax-case (build-lexical-reference 'value no-source
- 'tmp x)
- #'(key ...) #'(m ...)
- r
- mod))
- (list (expand #'val r empty-wrap mod))))
+ (build-call s
+ (build-simple-lambda no-source (list 'tmp) #f (list x) '()
+ (gen-syntax-case (build-lexical-reference 'value no-source
+ 'tmp x)
+ #'(key ...) #'(m ...)
+ r
+ mod))
+ (list (expand #'val r empty-wrap mod))))
(syntax-violation 'syntax-case "invalid literals list" e))))))))
;; The portable macroexpand seeds expand-top's mode m with 'e (for
@@ -2577,7 +2655,10 @@
(syntax-object-expression id)
(strip-anti-mark (syntax-object-wrap id))
r
- (syntax-object-module id)))
+ (syntax-object-module id)
+ ;; FIXME: come up with a better policy for
+ ;; resolve-syntax-parameters
+ #t))
(lambda (type value mod)
(case type
((lexical) (values 'lexical value))
@@ -2785,7 +2866,7 @@
#((macro-type . syntax-rules)
(patterns pattern ...))
(syntax-case x (k ...)
- ((dummy . pattern) #'template)
+ ((_ . pattern) #'template)
...)))
((_ (k ...) docstring ((keyword . pattern) template) ...)
(string? (syntax->datum #'docstring))
@@ -2795,7 +2876,7 @@
#((macro-type . syntax-rules)
(patterns pattern ...))
(syntax-case x (k ...)
- ((dummy . pattern) #'template)
+ ((_ . pattern) #'template)
...))))))
(define-syntax define-syntax-rule
diff --git a/module/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm
index 09e2e0a8d..31d79ec6f 100644
--- a/module/ice-9/weak-vector.scm
+++ b/module/ice-9/weak-vector.scm
@@ -1,6 +1,6 @@
;;; installed-scm-file
-;;;; Copyright (C) 2003, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2003, 2006, 2011 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
@@ -19,13 +19,8 @@
(define-module (ice-9 weak-vector)
- :export (make-weak-vector list->weak-vector weak-vector weak-vector?
- make-weak-key-alist-vector
- make-weak-value-alist-vector
- make-doubly-weak-alist-vector
- weak-key-alist-vector?
- weak-value-alist-vector?
- doubly-weak-alist-vector?) ; C
- )
+ #:export (make-weak-vector list->weak-vector weak-vector weak-vector?))
-(%init-weaks-builtins) ; defined in libguile/weaks.c
+(eval-when (load eval compile)
+ (load-extension (string-append "libguile-" (effective-version))
+ "scm_init_weak_vector_builtins"))
diff --git a/module/language/brainfuck/compile-tree-il.scm b/module/language/brainfuck/compile-tree-il.scm
index 33d563490..f9dd036e8 100644
--- a/module/language/brainfuck/compile-tree-il.scm
+++ b/module/language/brainfuck/compile-tree-il.scm
@@ -1,6 +1,6 @@
;;; Brainfuck for GNU Guile
-;; Copyright (C) 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2011 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
@@ -94,7 +94,7 @@
(parse-tree-il
`(let (pointer tape) (pointer tape)
((const 0)
- (apply (primitive make-vector) (const ,tape-size) (const 0)))
+ (call (primitive make-vector) (const ,tape-size) (const 0)))
,(compile-body exp)))
env
env))
@@ -109,11 +109,11 @@
(cond
((null? in)
;; No more input, build our output.
- (cond
- ((null? out) '(void)) ; no output
- ((null? (cdr out)) (car out)) ; single expression
- (else `(begin ,@(reverse out)))) ; sequence
- )
+ (cond
+ ((null? out) '(void)) ; no output
+ ((null? (cdr out)) (car out)) ; single expression
+ (else `(begin ,@(reverse out)))) ; sequence
+ )
(else
(pmatch (car in)
@@ -121,34 +121,34 @@
;; (set! pointer (+ pointer +-1))
((<bf-move> ,dir)
(emit `(set! (lexical pointer)
- (apply (primitive +) (lexical pointer) (const ,dir)))))
+ (call (primitive +) (lexical pointer) (const ,dir)))))
;; Cell increment +- is done as:
;; (vector-set! tape pointer (+ (vector-ref tape pointer) +-1))
((<bf-increment> ,inc)
- (emit `(apply (primitive vector-set!) (lexical tape) (lexical pointer)
- (apply (primitive +)
- (apply (primitive vector-ref)
- (lexical tape) (lexical pointer))
- (const ,inc)))))
+ (emit `(call (primitive vector-set!) (lexical tape) (lexical pointer)
+ (call (primitive +)
+ (call (primitive vector-ref)
+ (lexical tape) (lexical pointer))
+ (const ,inc)))))
;; Output . is done by converting the cell's integer value to a
;; character first and then printing out this character:
;; (write-char (integer->char (vector-ref tape pointer)))
((<bf-print>)
- (emit `(apply (primitive write-char)
- (apply (primitive integer->char)
- (apply (primitive vector-ref)
- (lexical tape) (lexical pointer))))))
+ (emit `(call (primitive write-char)
+ (call (primitive integer->char)
+ (call (primitive vector-ref)
+ (lexical tape) (lexical pointer))))))
;; Input , is done similarly, read in a character, get its ASCII
;; code and store it into the current cell:
;; (vector-set! tape pointer (char->integer (read-char)))
((<bf-read>)
- (emit `(apply (primitive vector-set!)
- (lexical tape) (lexical pointer)
- (apply (primitive char->integer)
- (apply (primitive read-char))))))
+ (emit `(call (primitive vector-set!)
+ (lexical tape) (lexical pointer)
+ (call (primitive char->integer)
+ (call (primitive read-char))))))
;; For loops [...] we use a letrec construction to execute the body until
;; the current cell gets zero. The body is compiled via a recursive call
@@ -171,14 +171,14 @@
((lambda ()
(lambda-case
((() #f #f #f () ())
- (if (apply (primitive =)
- (apply (primitive vector-ref)
- (lexical tape) (lexical pointer))
- (const 0))
+ (if (call (primitive =)
+ (call (primitive vector-ref)
+ (lexical tape) (lexical pointer))
+ (const 0))
(void)
(begin ,(compile-body body)
- (apply (lexical ,iterate)))))
+ (call (lexical ,iterate)))))
#f)))
- (apply (lexical ,iterate))))))
+ (call (lexical ,iterate))))))
(else (error "unknown brainfuck instruction" (car in))))))))
diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm
index a2401f442..0914f920a 100644
--- a/module/language/ecmascript/compile-tree-il.scm
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -32,7 +32,7 @@
(-> (@ '(language ecmascript impl) 'sym)))
(define-syntax-rule (@impl sym arg ...)
- (-> (apply (@implv sym) arg ...)))
+ (-> (call (@implv sym) arg ...)))
(define (empty-lexical-environment)
'())
@@ -95,23 +95,23 @@
(this
(@impl get-this))
((+ ,a)
- (-> (apply (-> (primitive '+))
- (@impl ->number (comp a e))
- (-> (const 0)))))
+ (-> (call (-> (primitive '+))
+ (@impl ->number (comp a e))
+ (-> (const 0)))))
((- ,a)
- (-> (apply (-> (primitive '-)) (-> (const 0)) (comp a e))))
+ (-> (call (-> (primitive '-)) (-> (const 0)) (comp a e))))
((~ ,a)
(@impl bitwise-not (comp a e)))
((! ,a)
(@impl logical-not (comp a e)))
((+ ,a ,b)
- (-> (apply (-> (primitive '+)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '+)) (comp a e) (comp b e))))
((- ,a ,b)
- (-> (apply (-> (primitive '-)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '-)) (comp a e) (comp b e))))
((/ ,a ,b)
- (-> (apply (-> (primitive '/)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '/)) (comp a e) (comp b e))))
((* ,a ,b)
- (-> (apply (-> (primitive '*)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '*)) (comp a e) (comp b e))))
((% ,a ,b)
(@impl mod (comp a e) (comp b e)))
((<< ,a ,b)
@@ -119,27 +119,27 @@
((>> ,a ,b)
(@impl shift (comp a e) (comp `(- ,b) e)))
((< ,a ,b)
- (-> (apply (-> (primitive '<)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '<)) (comp a e) (comp b e))))
((<= ,a ,b)
- (-> (apply (-> (primitive '<=)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '<=)) (comp a e) (comp b e))))
((> ,a ,b)
- (-> (apply (-> (primitive '>)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '>)) (comp a e) (comp b e))))
((>= ,a ,b)
- (-> (apply (-> (primitive '>=)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive '>=)) (comp a e) (comp b e))))
((in ,a ,b)
(@impl has-property? (comp a e) (comp b e)))
((== ,a ,b)
- (-> (apply (-> (primitive 'equal?)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive 'equal?)) (comp a e) (comp b e))))
((!= ,a ,b)
- (-> (apply (-> (primitive 'not))
- (-> (apply (-> (primitive 'equal?))
- (comp a e) (comp b e))))))
+ (-> (call (-> (primitive 'not))
+ (-> (call (-> (primitive 'equal?))
+ (comp a e) (comp b e))))))
((=== ,a ,b)
- (-> (apply (-> (primitive 'eqv?)) (comp a e) (comp b e))))
+ (-> (call (-> (primitive 'eqv?)) (comp a e) (comp b e))))
((!== ,a ,b)
- (-> (apply (-> (primitive 'not))
- (-> (apply (-> (primitive 'eqv?))
- (comp a e) (comp b e))))))
+ (-> (call (-> (primitive 'not))
+ (-> (call (-> (primitive 'eqv?))
+ (comp a e) (comp b e))))))
((& ,a ,b)
(@impl band (comp a e) (comp b e)))
((^ ,a ,b)
@@ -168,9 +168,9 @@
(begin1 (comp `(ref ,foo) e)
(lambda (var)
(-> (set! (lookup foo e)
- (-> (apply (-> (primitive '+))
- (-> (lexical var var))
- (-> (const 1)))))))))
+ (-> (call (-> (primitive '+))
+ (-> (lexical var var))
+ (-> (const 1)))))))))
((postinc (pref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
@@ -181,9 +181,9 @@
(@impl pput
(-> (lexical objvar objvar))
(-> (const prop))
- (-> (apply (-> (primitive '+))
- (-> (lexical tmpvar tmpvar))
- (-> (const 1))))))))))
+ (-> (call (-> (primitive '+))
+ (-> (lexical tmpvar tmpvar))
+ (-> (const 1))))))))))
((postinc (aref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
@@ -196,16 +196,16 @@
(@impl pput
(-> (lexical objvar objvar))
(-> (lexical propvar propvar))
- (-> (apply (-> (primitive '+))
- (-> (lexical tmpvar tmpvar))
- (-> (const 1))))))))))))
+ (-> (call (-> (primitive '+))
+ (-> (lexical tmpvar tmpvar))
+ (-> (const 1))))))))))))
((postdec (ref ,foo))
(begin1 (comp `(ref ,foo) e)
(lambda (var)
(-> (set (lookup foo e)
- (-> (apply (-> (primitive '-))
- (-> (lexical var var))
- (-> (const 1)))))))))
+ (-> (call (-> (primitive '-))
+ (-> (lexical var var))
+ (-> (const 1)))))))))
((postdec (pref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
@@ -216,9 +216,9 @@
(@impl pput
(-> (lexical objvar objvar))
(-> (const prop))
- (-> (apply (-> (primitive '-))
- (-> (lexical tmpvar tmpvar))
- (-> (const 1))))))))))
+ (-> (call (-> (primitive '-))
+ (-> (lexical tmpvar tmpvar))
+ (-> (const 1))))))))))
((postdec (aref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
@@ -238,18 +238,18 @@
(let ((v (lookup foo e)))
(-> (begin
(-> (set! v
- (-> (apply (-> (primitive '+))
- v
- (-> (const 1))))))
+ (-> (call (-> (primitive '+))
+ v
+ (-> (const 1))))))
v))))
((preinc (pref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
- (begin1 (-> (apply (-> (primitive '+))
- (@impl pget
- (-> (lexical objvar objvar))
- (-> (const prop)))
- (-> (const 1))))
+ (begin1 (-> (call (-> (primitive '+))
+ (@impl pget
+ (-> (lexical objvar objvar))
+ (-> (const prop)))
+ (-> (const 1))))
(lambda (tmpvar)
(@impl pput (-> (lexical objvar objvar))
(-> (const prop))
@@ -259,11 +259,11 @@
(lambda (objvar)
(let1 (comp prop e)
(lambda (propvar)
- (begin1 (-> (apply (-> (primitive '+))
- (@impl pget
- (-> (lexical objvar objvar))
- (-> (lexical propvar propvar)))
- (-> (const 1))))
+ (begin1 (-> (call (-> (primitive '+))
+ (@impl pget
+ (-> (lexical objvar objvar))
+ (-> (lexical propvar propvar)))
+ (-> (const 1))))
(lambda (tmpvar)
(@impl pput
(-> (lexical objvar objvar))
@@ -273,18 +273,18 @@
(let ((v (lookup foo e)))
(-> (begin
(-> (set! v
- (-> (apply (-> (primitive '-))
+ (-> (call (-> (primitive '-))
v
(-> (const 1))))))
v))))
((predec (pref ,obj ,prop))
(let1 (comp obj e)
(lambda (objvar)
- (begin1 (-> (apply (-> (primitive '-))
- (@impl pget
- (-> (lexical objvar objvar))
- (-> (const prop)))
- (-> (const 1))))
+ (begin1 (-> (call (-> (primitive '-))
+ (@impl pget
+ (-> (lexical objvar objvar))
+ (-> (const prop)))
+ (-> (const 1))))
(lambda (tmpvar)
(@impl pput
(-> (lexical objvar objvar))
@@ -295,11 +295,11 @@
(lambda (objvar)
(let1 (comp prop e)
(lambda (propvar)
- (begin1 (-> (apply (-> (primitive '-))
- (@impl pget
- (-> (lexical objvar objvar))
- (-> (lexical propvar propvar)))
- (-> (const 1))))
+ (begin1 (-> (call (-> (primitive '-))
+ (@impl pget
+ (-> (lexical objvar objvar))
+ (-> (lexical propvar propvar)))
+ (-> (const 1))))
(lambda (tmpvar)
(@impl pput
(-> (lexical objvar objvar))
@@ -337,7 +337,7 @@
(-> (lambda '()
`(lambda-case
((() #f #f #f () ())
- (apply ,(@impl pget obj prop) ,@args)))))))
+ (call ,(@impl pget obj prop) ,@args)))))))
((call (pref ,obj ,prop) ,args)
(comp `(call/this ,(comp obj e)
,(-> (const prop))
@@ -349,25 +349,25 @@
,@(map (lambda (x) (comp x e)) args))
e))
((call ,proc ,args)
- `(apply ,(comp proc e)
- ,@(map (lambda (x) (comp x e)) args)))
+ `(call ,(comp proc e)
+ ,@(map (lambda (x) (comp x e)) args)))
((return ,expr)
- (-> (apply (-> (primitive 'return))
- (comp expr e))))
+ (-> (call (-> (primitive 'return))
+ (comp expr e))))
((array . ,args)
- `(apply ,(@implv new-array)
- ,@(map (lambda (x) (comp x e)) args)))
+ `(call ,(@implv new-array)
+ ,@(map (lambda (x) (comp x e)) args)))
((object . ,args)
- `(apply ,(@implv new-object)
- ,@(map (lambda (x)
- (pmatch x
- ((,prop ,val)
- (-> (apply (-> (primitive 'cons))
- (-> (const prop))
- (comp val e))))
- (else
- (error "bad prop-val pair" x))))
- args)))
+ `(call ,(@implv new-object)
+ ,@(map (lambda (x)
+ (pmatch x
+ ((,prop ,val)
+ (-> (call (-> (primitive 'cons))
+ (-> (const prop))
+ (comp val e))))
+ (else
+ (error "bad prop-val pair" x))))
+ args)))
((pref ,obj ,prop)
(@impl pget
(comp obj e)
@@ -442,14 +442,14 @@
`((() #f #f #f () ())
,(-> (begin
(comp statement e)
- (-> (apply (-> (lexical '%continue %continue)))))))))))
+ (-> (call (-> (lexical '%continue %continue)))))))))))
(-> (lambda '()
(-> (lambda-case
`((() #f #f #f () ())
,(-> (if (@impl ->boolean (comp test e))
- (-> (apply (-> (lexical '%loop %loop))))
+ (-> (call (-> (lexical '%loop %loop))))
(@implv *undefined*)))))))))
- (-> (apply (-> (lexical '%loop %loop)))))))))
+ (-> (call (-> (lexical '%loop %loop)))))))))
((while ,test ,statement)
(let ((%continue (gensym "%continue ")))
(let ((e (econs '%continue %continue e)))
@@ -459,9 +459,9 @@
`((() #f #f #f () ())
,(-> (if (@impl ->boolean (comp test e))
(-> (begin (comp statement e)
- (-> (apply (-> (lexical '%continue %continue))))))
+ (-> (call (-> (lexical '%continue %continue))))))
(@implv *undefined*)))))))))
- (-> (apply (-> (lexical '%continue %continue)))))))))
+ (-> (call (-> (lexical '%continue %continue)))))))))
((for ,init ,test ,inc ,statement)
(let ((%continue (gensym "%continue ")))
@@ -475,10 +475,10 @@
(comp 'true e))
(-> (begin (comp statement e)
(comp (or inc '(begin)) e)
- (-> (apply (-> (lexical '%continue %continue))))))
+ (-> (call (-> (lexical '%continue %continue))))))
(@implv *undefined*)))))))))
(-> (begin (comp (or init '(begin)) e)
- (-> (apply (-> (lexical '%continue %continue)))))))))))
+ (-> (call (-> (lexical '%continue %continue)))))))))))
((for-in ,var ,object ,statement)
(let ((%enum (gensym "%enum "))
@@ -498,9 +498,9 @@
,(-> (const 'pop))))
e)
(comp statement e)
- (-> (apply (-> (lexical '%continue %continue))))))
+ (-> (call (-> (lexical '%continue %continue))))))
(@implv *undefined*)))))))))
- (-> (apply (-> (lexical '%continue %continue)))))))))
+ (-> (call (-> (lexical '%continue %continue)))))))))
((block ,x)
(comp x e))
diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm
index 0df21c7e6..e1d75ba7a 100644
--- a/module/language/elisp/compile-tree-il.scm
+++ b/module/language/elisp/compile-tree-il.scm
@@ -1,6 +1,6 @@
;;; Guile Emacs Lisp
-;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -109,7 +109,7 @@
;;; Build a call to a primitive procedure nicely.
(define (call-primitive loc sym . args)
- (make-application loc (make-primitive-ref loc sym) args))
+ (make-primcall loc sym args))
;;; Error reporting routine for syntax/compilation problems or build
;;; code for a runtime-error output.
@@ -118,9 +118,8 @@
(apply error args))
(define (runtime-error loc msg . args)
- (make-application loc
- (make-primitive-ref loc 'error)
- (cons (make-const loc msg) args)))
+ (make-primcall loc 'error
+ (cons (make-const loc msg) args)))
;;; Generate code to ensure a global symbol is there for further use of
;;; a given symbol. In general during the compilation, those needed are
@@ -129,13 +128,13 @@
;;; this routine.
(define (generate-ensure-global loc sym module)
- (make-application loc
- (make-module-ref loc runtime 'ensure-fluid! #t)
- (list (make-const loc module)
- (make-const loc sym))))
+ (make-call loc
+ (make-module-ref loc runtime 'ensure-fluid! #t)
+ (list (make-const loc module)
+ (make-const loc sym))))
(define (ensuring-globals loc bindings body)
- (make-sequence
+ (list->seq
loc
`(,@(map-globals-needed (fluid-ref bindings)
(lambda (mod sym)
@@ -151,12 +150,11 @@
(call-primitive
loc
'with-fluids*
- (make-application loc
- (make-primitive-ref loc 'list)
- (map (lambda (sym)
- (make-module-ref loc module sym #t))
- syms))
- (make-application loc (make-primitive-ref loc 'list) vals)
+ (make-primcall loc 'list
+ (map (lambda (sym)
+ (make-module-ref loc module sym #t))
+ syms))
+ (make-primcall loc 'list vals)
(make-lambda loc
'()
(make-lambda-case #f '() #f #f #f '() '() body #f))))
@@ -204,7 +202,7 @@
sym
module
(lambda ()
- (make-application
+ (make-call
loc
(make-module-ref loc runtime 'set-variable! #t)
(list (make-const loc module) (make-const loc sym) value)))
@@ -288,7 +286,7 @@
(map (lambda (el) (compile-expr (cdr el)))
for)))
(make-body (lambda ()
- (make-sequence loc (map compile-expr body)))))
+ (list->seq loc (map compile-expr body)))))
(if (null? lexical)
(let-dynamic loc (map car dynamic) module
(make-values dynamic) (make-body))
@@ -332,7 +330,7 @@
(map car bind))
(let iterate ((tail bind))
(if (null? tail)
- (make-sequence loc (map compile-expr body))
+ (list->seq loc (map compile-expr body))
(let ((sym (caar tail))
(value (compile-expr (cdar tail))))
(if (bind-lexically? sym module)
@@ -502,36 +500,35 @@
(map (lambda (x) (nil-value loc)) optional)
all-syms
(let ((compiled-body
- (make-sequence loc (map compile-expr body))))
- (make-sequence
+ (list->seq loc (map compile-expr body))))
+ (make-seq
loc
- (list
- (if rest
- (make-conditional
- loc
- (call-primitive loc
- 'null?
- (make-lexical-ref loc
- rest
- the-rest-sym))
- (make-lexical-set loc
- rest
- the-rest-sym
- (nil-value loc))
- (make-void loc))
+ (if rest
+ (make-conditional
+ loc
+ (call-primitive loc
+ 'null?
+ (make-lexical-ref loc
+ rest
+ the-rest-sym))
+ (make-lexical-set loc
+ rest
+ the-rest-sym
+ (nil-value loc))
(make-void loc))
- (if (null? dynamic)
- compiled-body
- (let-dynamic loc
- dynamic
- value-slot
- (map (lambda (name-sym)
- (make-lexical-ref
- loc
- (car name-sym)
- (cdr name-sym)))
- all-dyn-pairs)
- compiled-body)))))
+ (make-void loc))
+ (if (null? dynamic)
+ compiled-body
+ (let-dynamic loc
+ dynamic
+ value-slot
+ (map (lambda (name-sym)
+ (make-lexical-ref
+ loc
+ (car name-sym)
+ (cdr name-sym)))
+ all-dyn-pairs)
+ compiled-body))))
#f)))))))))
;;; Handle the common part of defconst and defvar, that is, checking for
@@ -623,7 +620,7 @@
(report-error loc "invalid symbol list" syms))
(let ((old (fluid-ref fluid))
(make-body (lambda ()
- (make-sequence loc (map compile-expr body)))))
+ (list->seq loc (map compile-expr body)))))
(if (eq? old 'all)
(make-body)
(let ((new (if (eq? syms 'all)
@@ -635,7 +632,7 @@
;;; Special operators
(defspecial progn (loc args)
- (make-sequence loc (map compile-expr args)))
+ (list->seq loc (map compile-expr args)))
(defspecial if (loc args)
(pmatch args
@@ -645,53 +642,51 @@
(compile-expr then)
(if (null? else)
(nil-value loc)
- (make-sequence loc
- (map compile-expr else)))))))
+ (list->seq loc (map compile-expr else)))))))
(defspecial defconst (loc args)
(pmatch args
((,sym ,value . ,doc)
(if (handle-var-def loc sym doc)
- (make-sequence loc
- (list (set-variable! loc
- sym
- value-slot
- (compile-expr value))
- (make-const loc sym)))))))
+ (make-seq loc
+ (set-variable! loc
+ sym
+ value-slot
+ (compile-expr value))
+ (make-const loc sym))))))
(defspecial defvar (loc args)
(pmatch args
((,sym) (make-const loc sym))
((,sym ,value . ,doc)
(if (handle-var-def loc sym doc)
- (make-sequence
+ (make-seq
loc
- (list
+ (make-conditional
+ loc
(make-conditional
loc
- (make-conditional
+ (call-primitive
loc
- (call-primitive
- loc
- 'module-bound?
- (call-primitive loc
- 'resolve-interface
- (make-const loc value-slot))
- (make-const loc sym))
+ 'module-bound?
(call-primitive loc
- 'fluid-bound?
- (make-module-ref loc value-slot sym #t))
- (make-const loc #f))
- (make-void loc)
- (set-variable! loc sym value-slot (compile-expr value)))
- (make-const loc sym)))))))
+ 'resolve-interface
+ (make-const loc value-slot))
+ (make-const loc sym))
+ (call-primitive loc
+ 'fluid-bound?
+ (make-module-ref loc value-slot sym #t))
+ (make-const loc #f))
+ (make-void loc)
+ (set-variable! loc sym value-slot (compile-expr value)))
+ (make-const loc sym))))))
(defspecial setq (loc args)
(define (car* x) (if (null? x) '() (car x)))
(define (cdr* x) (if (null? x) '() (cdr x)))
(define (cadr* x) (car* (cdr* x)))
(define (cddr* x) (cdr* (cdr* x)))
- (make-sequence
+ (list->seq
loc
(let loop ((args args) (last (nil-value loc)))
(if (null? args)
@@ -779,13 +774,12 @@
((,condition . ,body)
(let* ((itersym (gensym))
(compiled-body (map compile-expr body))
- (iter-call (make-application loc
- (make-lexical-ref loc
- 'iterate
- itersym)
- (list)))
- (full-body (make-sequence loc
- `(,@compiled-body ,iter-call)))
+ (iter-call (make-call loc
+ (make-lexical-ref loc
+ 'iterate
+ itersym)
+ (list)))
+ (full-body (list->seq loc `(,@compiled-body ,iter-call)))
(lambda-body (make-conditional loc
(compile-expr condition)
full-body
@@ -821,19 +815,16 @@
(if (not (symbol? name))
(report-error loc "expected symbol as macro name" name)
(let* ((tree-il
- (make-sequence
+ (make-seq
loc
- (list
- (set-variable!
- loc
- name
- function-slot
- (make-application
- loc
- (make-module-ref loc '(guile) 'cons #t)
- (list (make-const loc 'macro)
- (compile-lambda loc args body))))
- (make-const loc name)))))
+ (set-variable!
+ loc
+ name
+ function-slot
+ (make-primcall loc 'cons
+ (list (make-const loc 'macro)
+ (compile-lambda loc args body))))
+ (make-const loc name))))
(compile (ensuring-globals loc bindings-data tree-il)
#:from 'tree-il
#:to 'value)
@@ -844,14 +835,14 @@
((,name ,args . ,body)
(if (not (symbol? name))
(report-error loc "expected symbol as function name" name)
- (make-sequence loc
- (list (set-variable! loc
- name
- function-slot
- (compile-lambda loc
- args
- body))
- (make-const loc name)))))))
+ (make-seq loc
+ (set-variable! loc
+ name
+ function-slot
+ (compile-lambda loc
+ args
+ body))
+ (make-const loc name))))))
(defspecial #{`}# (loc args)
(pmatch args
@@ -876,13 +867,13 @@
=> (lambda (macro-function)
(compile-expr (apply macro-function arguments))))
(else
- (make-application loc
- (if (symbol? operator)
- (reference-variable loc
- operator
- function-slot)
- (compile-expr operator))
- (map compile-expr arguments))))))
+ (make-call loc
+ (if (symbol? operator)
+ (reference-variable loc
+ operator
+ function-slot)
+ (compile-expr operator))
+ (map compile-expr arguments))))))
;;; Compile a symbol expression. This is a variable reference or maybe
;;; some special value like nil.
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 1d391c4e1..69af8d65a 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -34,8 +34,9 @@
<toplevel-set> toplevel-set? make-toplevel-set toplevel-set-src toplevel-set-name toplevel-set-exp
<toplevel-define> toplevel-define? make-toplevel-define toplevel-define-src toplevel-define-name toplevel-define-exp
<conditional> conditional? make-conditional conditional-src conditional-test conditional-consequent conditional-alternate
- <application> application? make-application application-src application-proc application-args
- <sequence> sequence? make-sequence sequence-src sequence-exps
+ <call> call? make-call call-src call-proc call-args
+ <primcall> primcall? make-primcall primcall-src primcall-name primcall-args
+ <seq> seq? make-seq seq-head seq-tail
<lambda> lambda? make-lambda lambda-src lambda-meta lambda-body
<lambda-case> lambda-case? make-lambda-case lambda-case-src
lambda-case-req lambda-case-opt lambda-case-rest lambda-case-kw
@@ -45,13 +46,15 @@
<letrec> letrec? make-letrec letrec-src letrec-in-order? letrec-names letrec-gensyms letrec-vals letrec-body
<fix> fix? make-fix fix-src fix-names fix-gensyms fix-vals fix-body
<let-values> let-values? make-let-values let-values-src let-values-exp let-values-body
- <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder
+ <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-pre dynwind-body dynwind-post dynwind-unwinder
<dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body
<dynref> dynref? make-dynref dynref-src dynref-fluid
<dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp
<prompt> prompt? make-prompt prompt-src prompt-tag prompt-body prompt-handler
<abort> abort? make-abort abort-src abort-tag abort-args abort-tail
+ list->seq
+
parse-tree-il
unparse-tree-il
tree-il->scheme
@@ -118,8 +121,9 @@
;; (<toplevel-set> name exp)
;; (<toplevel-define> name exp)
;; (<conditional> test consequent alternate)
- ;; (<application> proc args)
- ;; (<sequence> exps)
+ ;; (<call> proc args)
+ ;; (<primcall> name args)
+ ;; (<seq> head tail)
;; (<lambda> meta body)
;; (<lambda-case> req opt rest kw inits gensyms body alternate)
;; (<let> names gensyms vals body)
@@ -129,7 +133,7 @@
(define-type (<tree-il> #:common-slots (src) #:printer print-tree-il)
(<fix> names gensyms vals body)
(<let-values> exp body)
- (<dynwind> winder body unwinder)
+ (<dynwind> winder pre body post unwinder)
(<dynref> fluid)
(<dynset> fluid exp)
(<prompt> tag body handler)
@@ -137,6 +141,14 @@
+;; A helper.
+(define (list->seq loc exps)
+ (if (null? (cdr exps))
+ (car exps)
+ (make-seq loc (car exps) (list->seq #f (cdr exps)))))
+
+
+
(define (location x)
(and (pair? x)
(let ((props (source-properties x)))
@@ -149,8 +161,11 @@
((void)
(make-void loc))
- ((apply ,proc . ,args)
- (make-application loc (retrans proc) (map retrans args)))
+ ((call ,proc . ,args)
+ (make-call loc (retrans proc) (map retrans args)))
+
+ ((primcall ,name . ,args)
+ (make-primcall loc name (map retrans args)))
((if ,test ,consequent ,alternate)
(make-conditional loc (retrans test) (retrans consequent) (retrans alternate)))
@@ -209,8 +224,12 @@
((const ,exp)
(make-const loc exp))
+ ((seq ,head ,tail)
+ (make-seq loc (retrans head) (retrans tail)))
+
+ ;; Convenience.
((begin . ,exps)
- (make-sequence loc (map retrans exps)))
+ (list->seq loc (map retrans exps)))
((let ,names ,gensyms ,vals ,body)
(make-let loc names gensyms (map retrans vals) (retrans body)))
@@ -227,8 +246,10 @@
((let-values ,exp ,body)
(make-let-values loc (retrans exp) (retrans body)))
- ((dynwind ,winder ,body ,unwinder)
- (make-dynwind loc (retrans winder) (retrans body) (retrans unwinder)))
+ ((dynwind ,winder ,pre ,body ,post ,unwinder)
+ (make-dynwind loc (retrans winder) (retrans pre)
+ (retrans body)
+ (retrans post) (retrans unwinder)))
((dynlet ,fluids ,vals ,body)
(make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body)))
@@ -253,8 +274,11 @@
((<void>)
'(void))
- ((<application> proc args)
- `(apply ,(unparse-tree-il proc) ,@(map unparse-tree-il args)))
+ ((<call> proc args)
+ `(call ,(unparse-tree-il proc) ,@(map unparse-tree-il args)))
+
+ ((<primcall> name args)
+ `(primcall ,name ,@(map unparse-tree-il args)))
((<conditional> test consequent alternate)
`(if ,(unparse-tree-il test) ,(unparse-tree-il consequent) ,(unparse-tree-il alternate)))
@@ -294,9 +318,9 @@
((<const> exp)
`(const ,exp))
- ((<sequence> exps)
- `(begin ,@(map unparse-tree-il exps)))
-
+ ((<seq> head tail)
+ `(seq ,(unparse-tree-il head) ,(unparse-tree-il tail)))
+
((<let> names gensyms vals body)
`(let ,names ,gensyms ,(map unparse-tree-il vals) ,(unparse-tree-il body)))
@@ -310,9 +334,10 @@
((<let-values> exp body)
`(let-values ,(unparse-tree-il exp) ,(unparse-tree-il body)))
- ((<dynwind> winder body unwinder)
- `(dynwind ,(unparse-tree-il winder) ,(unparse-tree-il body)
- ,(unparse-tree-il unwinder)))
+ ((<dynwind> winder pre body post unwinder)
+ `(dynwind ,(unparse-tree-il winder) ,(unparse-tree-il pre)
+ ,(unparse-tree-il body)
+ ,(unparse-tree-il post) ,(unparse-tree-il unwinder)))
((<dynlet> fluids vals body)
`(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals)
@@ -336,9 +361,12 @@
((<void>)
'(if #f #f))
- ((<application> proc args)
+ ((<call> proc args)
`(,(tree-il->scheme proc) ,@(map tree-il->scheme args)))
+ ((<primcall> name args)
+ `(,name ,@(map tree-il->scheme args)))
+
((<conditional> test consequent alternate)
(if (void? alternate)
`(if ,(tree-il->scheme test) ,(tree-il->scheme consequent))
@@ -433,8 +461,14 @@
exp
(list 'quote exp)))
- ((<sequence> exps)
- `(begin ,@(map tree-il->scheme exps)))
+ ((<seq> head tail)
+ `(begin ,(tree-il->scheme head)
+ ,@(unfold (lambda (x) (not (seq? x)))
+ (lambda (x) (tree-il->scheme (seq-head x)))
+ seq-tail
+ tail
+ (lambda (x)
+ (list (tree-il->scheme x))))))
((<let> gensyms vals body)
`(let ,(map list gensyms (map tree-il->scheme vals)) ,(tree-il->scheme body)))
@@ -453,7 +487,7 @@
`(call-with-values (lambda () ,(tree-il->scheme exp))
,(tree-il->scheme (make-lambda #f '() body))))
- ((<dynwind> body winder unwinder)
+ ((<dynwind> winder body unwinder)
`(dynamic-wind ,(tree-il->scheme winder)
(lambda () ,(tree-il->scheme body))
,(tree-il->scheme unwinder)))
@@ -478,7 +512,8 @@
((<abort> tag args tail)
- `(apply abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args)
+ `(apply abort-to-prompt
+ ,(tree-il->scheme tag) ,@(map tree-il->scheme args)
,(tree-il->scheme tail)))))
@@ -489,7 +524,7 @@ invoked as `(PROC TREE SEED)', where TREE is the sub-tree or leaf considered
and SEED is the current result, intially seeded with SEED.
This is an implementation of `foldts' as described by Andy Wingo in
-``Applications of fold to XML transformation''."
+``Calls of fold to XML transformation''."
(let loop ((tree tree)
(result seed))
(if (or (null? tree) (pair? tree))
@@ -507,10 +542,12 @@ This is an implementation of `foldts' as described by Andy Wingo in
(up tree (loop alternate
(loop consequent
(loop test (down tree result))))))
- ((<application> proc args)
+ ((<call> proc args)
(up tree (loop (cons proc args) (down tree result))))
- ((<sequence> exps)
- (up tree (loop exps (down tree result))))
+ ((<primcall> name args)
+ (up tree (loop args (down tree result))))
+ ((<seq> head tail)
+ (up tree (loop tail (loop head (down tree result)))))
((<lambda> body)
(up tree (loop body (down tree result))))
((<lambda-case> inits body alternate)
@@ -532,10 +569,13 @@ This is an implementation of `foldts' as described by Andy Wingo in
(down tree result)))))
((<let-values> exp body)
(up tree (loop body (loop exp (down tree result)))))
- ((<dynwind> body winder unwinder)
+ ((<dynwind> winder pre body post unwinder)
(up tree (loop unwinder
- (loop winder
- (loop body (down tree result))))))
+ (loop post
+ (loop body
+ (loop pre
+ (loop winder
+ (down tree result))))))))
((<dynlet> fluids vals body)
(up tree (loop body
(loop vals
@@ -578,11 +618,14 @@ This is an implementation of `foldts' as described by Andy Wingo in
(let*-values (((seed ...) (foldts test seed ...))
((seed ...) (foldts consequent seed ...)))
(foldts alternate seed ...)))
- ((<application> proc args)
+ ((<call> proc args)
(let-values (((seed ...) (foldts proc seed ...)))
(fold-values foldts args seed ...)))
- ((<sequence> exps)
- (fold-values foldts exps seed ...))
+ ((<primcall> name args)
+ (fold-values foldts args seed ...))
+ ((<seq> head tail)
+ (let-values (((seed ...) (foldts head seed ...)))
+ (foldts tail seed ...)))
((<lambda> body)
(foldts body seed ...))
((<lambda-case> inits body alternate)
@@ -603,9 +646,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
((<let-values> exp body)
(let*-values (((seed ...) (foldts exp seed ...)))
(foldts body seed ...)))
- ((<dynwind> body winder unwinder)
- (let*-values (((seed ...) (foldts body seed ...))
- ((seed ...) (foldts winder seed ...)))
+ ((<dynwind> winder pre body post unwinder)
+ (let*-values (((seed ...) (foldts winder seed ...))
+ ((seed ...) (foldts pre seed ...))
+ ((seed ...) (foldts body seed ...))
+ ((seed ...) (foldts post seed ...)))
(foldts unwinder seed ...)))
((<dynlet> fluids vals body)
(let*-values (((seed ...) (fold-values foldts fluids seed ...))
@@ -631,9 +676,12 @@ This is an implementation of `foldts' as described by Andy Wingo in
(define (post-order! f x)
(let lp ((x x))
(record-case x
- ((<application> proc args)
- (set! (application-proc x) (lp proc))
- (set! (application-args x) (map lp args)))
+ ((<call> proc args)
+ (set! (call-proc x) (lp proc))
+ (set! (call-args x) (map lp args)))
+
+ ((<primcall> name args)
+ (set! (primcall-args x) (map lp args)))
((<conditional> test consequent alternate)
(set! (conditional-test x) (lp test))
@@ -661,9 +709,10 @@ This is an implementation of `foldts' as described by Andy Wingo in
(if alternate
(set! (lambda-case-alternate x) (lp alternate))))
- ((<sequence> exps)
- (set! (sequence-exps x) (map lp exps)))
-
+ ((<seq> head tail)
+ (set! (seq-head x) (lp head))
+ (set! (seq-tail x) (lp tail)))
+
((<let> gensyms vals body)
(set! (let-vals x) (map lp vals))
(set! (let-body x) (lp body)))
@@ -680,9 +729,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (let-values-exp x) (lp exp))
(set! (let-values-body x) (lp body)))
- ((<dynwind> body winder unwinder)
- (set! (dynwind-body x) (lp body))
+ ((<dynwind> winder pre body post unwinder)
(set! (dynwind-winder x) (lp winder))
+ (set! (dynwind-pre x) (lp pre))
+ (set! (dynwind-body x) (lp body))
+ (set! (dynwind-post x) (lp post))
(set! (dynwind-unwinder x) (lp unwinder)))
((<dynlet> fluids vals body)
@@ -715,9 +766,12 @@ This is an implementation of `foldts' as described by Andy Wingo in
(let lp ((x x))
(let ((x (or (f x) x)))
(record-case x
- ((<application> proc args)
- (set! (application-proc x) (lp proc))
- (set! (application-args x) (map lp args)))
+ ((<call> proc args)
+ (set! (call-proc x) (lp proc))
+ (set! (call-args x) (map lp args)))
+
+ ((<primcall> name args)
+ (set! (primcall-args x) (map lp args)))
((<conditional> test consequent alternate)
(set! (conditional-test x) (lp test))
@@ -744,9 +798,10 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (lambda-case-body x) (lp body))
(if alternate (set! (lambda-case-alternate x) (lp alternate))))
- ((<sequence> exps)
- (set! (sequence-exps x) (map lp exps)))
-
+ ((<seq> head tail)
+ (set! (seq-head x) (lp head))
+ (set! (seq-tail x) (lp tail)))
+
((<let> vals body)
(set! (let-vals x) (map lp vals))
(set! (let-body x) (lp body)))
@@ -763,9 +818,11 @@ This is an implementation of `foldts' as described by Andy Wingo in
(set! (let-values-exp x) (lp exp))
(set! (let-values-body x) (lp body)))
- ((<dynwind> body winder unwinder)
- (set! (dynwind-body x) (lp body))
+ ((<dynwind> winder pre body post unwinder)
(set! (dynwind-winder x) (lp winder))
+ (set! (dynwind-pre x) (lp pre))
+ (set! (dynwind-body x) (lp body))
+ (set! (dynwind-post x) (lp post))
(set! (dynwind-unwinder x) (lp unwinder)))
((<dynlet> fluids vals body)
diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 9bcc92fdc..28312514a 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -180,10 +180,13 @@
(analyze! x new-proc (append labels labels-in-proc) #t #f))
(define (recur x new-proc) (analyze! x new-proc '() tail? #f))
(record-case x
- ((<application> proc args)
+ ((<call> proc args)
(apply lset-union eq? (step-tail-call proc args)
(map step args)))
+ ((<primcall> args)
+ (apply lset-union eq? (map step args)))
+
((<conditional> test consequent alternate)
(lset-union eq? (step test) (step-tail consequent) (step-tail alternate)))
@@ -222,13 +225,8 @@
((<toplevel-define> exp)
(step exp))
- ((<sequence> exps)
- (let lp ((exps exps) (ret '()))
- (cond ((null? exps) '())
- ((null? (cdr exps))
- (lset-union eq? ret (step-tail (car exps))))
- (else
- (lp (cdr exps) (lset-union eq? ret (step (car exps))))))))
+ ((<seq> head tail)
+ (lset-union eq? (step head) (step-tail tail)))
((<lambda> body)
;; order is important here
@@ -339,8 +337,10 @@
((<let-values> exp body)
(lset-union eq? (step exp) (step body)))
- ((<dynwind> body winder unwinder)
- (lset-union eq? (step body) (step winder) (step unwinder)))
+ ((<dynwind> winder pre body post unwinder)
+ (lset-union eq? (step winder) (step pre)
+ (step body)
+ (step post) (step unwinder)))
((<dynlet> fluids vals body)
(apply lset-union eq? (step body) (map step (append fluids vals))))
@@ -367,9 +367,12 @@
(define (allocate! x proc n)
(define (recur y) (allocate! y proc n))
(record-case x
- ((<application> proc args)
+ ((<call> proc args)
(apply max (recur proc) (map recur args)))
+ ((<primcall> args)
+ (apply max n (map recur args)))
+
((<conditional> test consequent alternate)
(max (recur test) (recur consequent) (recur alternate)))
@@ -385,8 +388,9 @@
((<toplevel-define> exp)
(recur exp))
- ((<sequence> exps)
- (apply max (map recur exps)))
+ ((<seq> head tail)
+ (max (recur head)
+ (recur tail)))
((<lambda> body)
;; allocate closure vars in order
@@ -509,8 +513,10 @@
((<let-values> exp body)
(max (recur exp) (recur body)))
- ((<dynwind> body winder unwinder)
- (max (recur body) (recur winder) (recur unwinder)))
+ ((<dynwind> winder pre body post unwinder)
+ (max (recur winder) (recur pre)
+ (recur body)
+ (recur post) (recur unwinder)))
((<dynlet> fluids vals body)
(apply max (recur body) (map recur (append fluids vals))))
@@ -866,7 +872,7 @@ accurate information is missing from a given `tree-il' element."
(defs toplevel-info-defs)) ;; (VARIABLE-NAME ...)
(define (goops-toplevel-definition proc args env)
- ;; If application of PROC to ARGS is a GOOPS top-level definition, return
+ ;; If call of PROC to ARGS is a GOOPS top-level definition, return
;; the name of the variable being defined; otherwise return #f. This
;; assumes knowledge of the current implementation of `define-class' et al.
(define (toplevel-define-arg args)
@@ -927,7 +933,7 @@ accurate information is missing from a given `tree-il' element."
(make-toplevel-info (vhash-delq name refs)
(vhash-consq name #t defs)))
- ((<application> proc args)
+ ((<call> proc args)
;; Check for a dynamic top-level definition, as is
;; done by code expanded from GOOPS macros.
(let ((name (goops-toplevel-definition proc args
@@ -965,12 +971,12 @@ accurate information is missing from a given `tree-il' element."
(define-record-type <arity-info>
(make-arity-info toplevel-calls lexical-lambdas toplevel-lambdas)
arity-info?
- (toplevel-calls toplevel-procedure-calls) ;; ((NAME . APPLICATION) ...)
+ (toplevel-calls toplevel-procedure-calls) ;; ((NAME . CALL) ...)
(lexical-lambdas lexical-lambdas) ;; ((GENSYM . DEFINITION) ...)
(toplevel-lambdas toplevel-lambdas)) ;; ((NAME . DEFINITION) ...)
-(define (validate-arity proc application lexical?)
- ;; Validate the argument count of APPLICATION, a tree-il application of
+(define (validate-arity proc call lexical?)
+ ;; Validate the argument count of CALL, a tree-il call of
;; PROC, emitting a warning in case of argument count mismatch.
(define (filter-keyword-args keywords allow-other-keys? args)
@@ -1030,8 +1036,8 @@ accurate information is missing from a given `tree-il' element."
(else
(values #f #f))))))))
- (let ((args (application-args application))
- (src (tree-il-src application)))
+ (let ((args (call-args call))
+ (src (tree-il-src call)))
(call-with-values (lambda () (arities proc))
(lambda (name arities)
(define matches?
@@ -1118,7 +1124,7 @@ accurate information is missing from a given `tree-il' element."
((<fix> gensyms vals)
(fold extend info gensyms vals))
- ((<application> proc args src)
+ ((<call> proc args src)
(record-case proc
((<lambda> body)
(validate-arity proc x #t)
@@ -1178,9 +1184,9 @@ accurate information is missing from a given `tree-il' element."
(let ((toplevel-calls (toplevel-procedure-calls result))
(toplevel-lambdas (toplevel-lambdas result)))
(vlist-for-each
- (lambda (name+application)
- (let* ((name (car name+application))
- (application (cdr name+application))
+ (lambda (name+call)
+ (let* ((name (car name+call))
+ (call (cdr name+call))
(proc
(or (and=> (vhash-assq name toplevel-lambdas) cdr)
(and (module? env)
@@ -1195,7 +1201,7 @@ accurate information is missing from a given `tree-il' element."
(module-ref env name))))
proc)))
(if (or (lambda? proc*) (procedure? proc*))
- (validate-arity proc* application (lambda? proc*)))))
+ (validate-arity proc* call (lambda? proc*)))))
toplevel-calls)))
(make-arity-info vlist-null vlist-null vlist-null)))
@@ -1352,7 +1358,7 @@ accurate information is missing from a given `tree-il' element."
(match x
(($ <const> _ exp)
exp)
- (($ <application> _
+ (($ <call> _
(or ($ <toplevel-ref> _ '_) ($ <module-ref> _ '_))
(($ <const> _ (and (? string?) fmt))))
;; Gettexted literals, like `(_ "foo")'.
@@ -1439,17 +1445,17 @@ accurate information is missing from a given `tree-il' element."
(false-if-exception (module-ref env name))))
(match x
- (($ <application> src ($ <toplevel-ref> _ name) args)
+ (($ <call> src ($ <toplevel-ref> _ name) args)
(let ((proc (resolve-toplevel name)))
(if (or (and (eq? proc (@ (guile) simple-format))
(check-simple-format-args args
(or src (find pair? locs))))
(eq? proc (@ (ice-9 format) format)))
(check-format-args args (or src (find pair? locs))))))
- (($ <application> src ($ <module-ref> _ '(ice-9 format) 'format) args)
+ (($ <call> src ($ <module-ref> _ '(ice-9 format) 'format) args)
(check-format-args args (or src (find pair? locs))))
- (($ <application> src ($ <module-ref> _ '(guile)
- (or 'format 'simple-format))
+ (($ <call> src ($ <module-ref> _ '(guile)
+ (or 'format 'simple-format))
args)
(and (check-simple-format-args args
(or src (find pair? locs)))
diff --git a/module/language/tree-il/canonicalize.scm b/module/language/tree-il/canonicalize.scm
index 04f561282..27d72956f 100644
--- a/module/language/tree-il/canonicalize.scm
+++ b/module/language/tree-il/canonicalize.scm
@@ -36,16 +36,6 @@
(post-order!
(lambda (x)
(match x
- (($ <sequence> src (tail))
- tail)
- (($ <sequence> src exps)
- (and (any sequence? exps)
- (make-sequence src
- (append-map (lambda (x)
- (if (sequence? x)
- (sequence-exps x)
- (list x)))
- exps))))
(($ <let> src () () () body)
body)
(($ <letrec> src _ () () () body)
@@ -65,7 +55,7 @@
(else #f)))
(define (thunk-application? x)
(match x
- (($ <application> _
+ (($ <call> _
($ <lambda> _ _ ($ <lambda-case> _ () #f #f #f))
()) #t)
(_ #f)))
@@ -73,7 +63,7 @@
(define thunk
(make-lambda #f '()
(make-lambda-case #f '() #f #f #f '() '() body #f)))
- (make-application #f thunk '()))
+ (make-call #f thunk '()))
;; This code has a nasty job to do: to ensure that either the
;; handler is escape-only, or the body is the application of a
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index a9f6df938..81defa167 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -115,6 +115,9 @@
((class-of . 1) . class-of)
((@slot-ref . 2) . slot-ref)
((@slot-set! . 3) . slot-set)
+ ((string-length . 1) . string-length)
+ ((string-ref . 2) . string-ref)
+ ((vector-length . 1) . vector-length)
((vector-ref . 2) . vector-ref)
((vector-set! . 3) . vector-set)
((variable-ref . 1) . variable-ref)
@@ -268,199 +271,12 @@
(emit-code src (make-glil-const exp))))
(maybe-emit-return))
- ;; FIXME: should represent sequence as exps tail
- ((<sequence> exps)
- (let lp ((exps exps))
- (if (null? (cdr exps))
- (comp-tail (car exps))
- (begin
- (comp-drop (car exps))
- (lp (cdr exps))))))
-
- ((<application> src proc args)
- ;; FIXME: need a better pattern-matcher here
+ ((<seq> head tail)
+ (comp-drop head)
+ (comp-tail tail))
+
+ ((<call> src proc args)
(cond
- ((and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) '@apply)
- (>= (length args) 1))
- (let ((proc (car args))
- (args (cdr args)))
- (cond
- ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
- (not (eq? context 'push)) (not (eq? context 'vals)))
- ;; tail: (lambda () (apply values '(1 2)))
- ;; drop: (lambda () (apply values '(1 2)) 3)
- ;; push: (lambda () (list (apply values '(10 12)) 1))
- (case context
- ((drop) (for-each comp-drop args) (maybe-emit-return))
- ((tail)
- (for-each comp-push args)
- (emit-code src (make-glil-call 'return/values* (length args))))))
-
- (else
- (case context
- ((tail)
- (comp-push proc)
- (for-each comp-push args)
- (emit-code src (make-glil-call 'tail-apply (1+ (length args)))))
- ((push)
- (emit-code src (make-glil-call 'new-frame 0))
- (comp-push proc)
- (for-each comp-push args)
- (emit-code src (make-glil-call 'apply (1+ (length args))))
- (maybe-emit-return))
- ((vals)
- (comp-vals
- (make-application src (make-primitive-ref #f 'apply)
- (cons proc args))
- MVRA)
- (maybe-emit-return))
- ((drop)
- ;; Well, shit. The proc might return any number of
- ;; values (including 0), since it's in a drop context,
- ;; yet apply does not create a MV continuation. So we
- ;; mv-call out to our trampoline instead.
- (comp-drop
- (make-application src (make-primitive-ref #f 'apply)
- (cons proc args)))
- (maybe-emit-return)))))))
-
- ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values))
- ;; tail: (lambda () (values '(1 2)))
- ;; drop: (lambda () (values '(1 2)) 3)
- ;; push: (lambda () (list (values '(10 12)) 1))
- ;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
- (case context
- ((drop) (for-each comp-drop args) (maybe-emit-return))
- ((push)
- (case (length args)
- ((0)
- ;; FIXME: This is surely an error. We need to add a
- ;; values-mismatch warning pass.
- (emit-code src (make-glil-call 'new-frame 0))
- (comp-push proc)
- (emit-code src (make-glil-call 'call 0))
- (maybe-emit-return))
- (else
- ;; Taking advantage of unspecified order of evaluation of
- ;; arguments.
- (for-each comp-drop (cdr args))
- (comp-push (car args))
- (maybe-emit-return))))
- ((vals)
- (for-each comp-push args)
- (emit-code #f (make-glil-const (length args)))
- (emit-branch src 'br MVRA))
- ((tail)
- (for-each comp-push args)
- (emit-code src (let ((len (length args)))
- (if (= len 1)
- (make-glil-call 'return 1)
- (make-glil-call 'return/values len)))))))
-
- ((and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) '@call-with-values)
- (= (length args) 2))
- ;; CONSUMER
- ;; PRODUCER
- ;; (mv-call MV)
- ;; ([tail]-call 1)
- ;; goto POST
- ;; MV: [tail-]call/nargs
- ;; POST: (maybe-drop)
- (case context
- ((vals)
- ;; Fall back.
- (comp-vals
- (make-application src (make-primitive-ref #f 'call-with-values)
- args)
- MVRA)
- (maybe-emit-return))
- (else
- (let ((MV (make-label)) (POST (make-label))
- (producer (car args)) (consumer (cadr args)))
- (if (not (eq? context 'tail))
- (emit-code src (make-glil-call 'new-frame 0)))
- (comp-push consumer)
- (emit-code src (make-glil-call 'new-frame 0))
- (comp-push producer)
- (emit-code src (make-glil-mv-call 0 MV))
- (case context
- ((tail) (emit-code src (make-glil-call 'tail-call 1)))
- (else (emit-code src (make-glil-call 'call 1))
- (emit-branch #f 'br POST)))
- (emit-label MV)
- (case context
- ((tail) (emit-code src (make-glil-call 'tail-call/nargs 0)))
- (else (emit-code src (make-glil-call 'call/nargs 0))
- (emit-label POST)
- (if (eq? context 'drop)
- (emit-code #f (make-glil-call 'drop 1)))
- (maybe-emit-return)))))))
-
- ((and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) '@call-with-current-continuation)
- (= (length args) 1))
- (case context
- ((tail)
- (comp-push (car args))
- (emit-code src (make-glil-call 'tail-call/cc 1)))
- ((vals)
- (comp-vals
- (make-application
- src (make-primitive-ref #f 'call-with-current-continuation)
- args)
- MVRA)
- (maybe-emit-return))
- ((push)
- (comp-push (car args))
- (emit-code src (make-glil-call 'call/cc 1))
- (maybe-emit-return))
- ((drop)
- ;; Crap. Just like `apply' in drop context.
- (comp-drop
- (make-application
- src (make-primitive-ref #f 'call-with-current-continuation)
- args))
- (maybe-emit-return))))
-
- ;; A hack for variable-set, the opcode for which takes its args
- ;; reversed, relative to the variable-set! function
- ((and (primitive-ref? proc)
- (eq? (primitive-ref-name proc) 'variable-set!)
- (= (length args) 2))
- (comp-push (cadr args))
- (comp-push (car args))
- (emit-code src (make-glil-call 'variable-set 2))
- (case context
- ((tail push vals) (emit-code #f (make-glil-void))))
- (maybe-emit-return))
-
- ((and (primitive-ref? proc)
- (or (hash-ref *primcall-ops*
- (cons (primitive-ref-name proc) (length args)))
- (hash-ref *primcall-ops* (primitive-ref-name proc))))
- => (lambda (op)
- (for-each comp-push args)
- (emit-code src (make-glil-call op (length args)))
- (case (instruction-pushes op)
- ((0)
- (case context
- ((tail push vals) (emit-code #f (make-glil-void))))
- (maybe-emit-return))
- ((1)
- (case context
- ((drop) (emit-code #f (make-glil-call 'drop 1))))
- (maybe-emit-return))
- ((-1)
- ;; A control instruction, like return/values. Here we
- ;; just have to hope that the author of the tree-il
- ;; knew what they were doing.
- *unspecified*)
- (else
- (error "bad primitive op: too many pushes"
- op (instruction-pushes op))))))
-
;; call to the same lambda-case in tail position
((and (lexical-ref? proc)
self-label (eq? (lexical-ref-gensym proc) self-label)
@@ -542,6 +358,157 @@
(emit-branch #f 'br RA)
(emit-label POST)))))))))
+ ((<primcall> src name args)
+ (pmatch (cons name args)
+ ((@apply ,proc . ,args)
+ (cond
+ ((and (primitive-ref? proc) (eq? (primitive-ref-name proc) 'values)
+ (not (eq? context 'push)) (not (eq? context 'vals)))
+ ;; tail: (lambda () (apply values '(1 2)))
+ ;; drop: (lambda () (apply values '(1 2)) 3)
+ ;; push: (lambda () (list (apply values '(10 12)) 1))
+ (case context
+ ((drop) (for-each comp-drop args) (maybe-emit-return))
+ ((tail)
+ (for-each comp-push args)
+ (emit-code src (make-glil-call 'return/values* (length args))))))
+
+ (else
+ (case context
+ ((tail)
+ (comp-push proc)
+ (for-each comp-push args)
+ (emit-code src (make-glil-call 'tail-apply (1+ (length args)))))
+ ((push)
+ (emit-code src (make-glil-call 'new-frame 0))
+ (comp-push proc)
+ (for-each comp-push args)
+ (emit-code src (make-glil-call 'apply (1+ (length args))))
+ (maybe-emit-return))
+ (else
+ (comp-tail (make-primcall src 'apply (cons proc args))))))))
+
+ ((values . _)
+ ;; tail: (lambda () (values '(1 2)))
+ ;; drop: (lambda () (values '(1 2)) 3)
+ ;; push: (lambda () (list (values '(10 12)) 1))
+ ;; vals: (let-values (((a b ...) (values 1 2 ...))) ...)
+ (case context
+ ((drop) (for-each comp-drop args) (maybe-emit-return))
+ ((push)
+ (case (length args)
+ ((0)
+ ;; FIXME: This is surely an error. We need to add a
+ ;; values-mismatch warning pass.
+ (comp-push (make-call src (make-primitive-ref #f 'values)
+ '())))
+ (else
+ ;; Taking advantage of unspecified order of evaluation of
+ ;; arguments.
+ (for-each comp-drop (cdr args))
+ (comp-push (car args))
+ (maybe-emit-return))))
+ ((vals)
+ (for-each comp-push args)
+ (emit-code #f (make-glil-const (length args)))
+ (emit-branch src 'br MVRA))
+ ((tail)
+ (for-each comp-push args)
+ (emit-code src (let ((len (length args)))
+ (if (= len 1)
+ (make-glil-call 'return 1)
+ (make-glil-call 'return/values len)))))))
+
+ ((@call-with-values ,producer ,consumer)
+ ;; CONSUMER
+ ;; PRODUCER
+ ;; (mv-call MV)
+ ;; ([tail]-call 1)
+ ;; goto POST
+ ;; MV: [tail-]call/nargs
+ ;; POST: (maybe-drop)
+ (case context
+ ((vals)
+ ;; Fall back.
+ (comp-tail (make-primcall src 'call-with-values args)))
+ (else
+ (let ((MV (make-label)) (POST (make-label)))
+ (if (not (eq? context 'tail))
+ (emit-code src (make-glil-call 'new-frame 0)))
+ (comp-push consumer)
+ (emit-code src (make-glil-call 'new-frame 0))
+ (comp-push producer)
+ (emit-code src (make-glil-mv-call 0 MV))
+ (case context
+ ((tail) (emit-code src (make-glil-call 'tail-call 1)))
+ (else (emit-code src (make-glil-call 'call 1))
+ (emit-branch #f 'br POST)))
+ (emit-label MV)
+ (case context
+ ((tail) (emit-code src (make-glil-call 'tail-call/nargs 0)))
+ (else (emit-code src (make-glil-call 'call/nargs 0))
+ (emit-label POST)
+ (if (eq? context 'drop)
+ (emit-code #f (make-glil-call 'drop 1)))
+ (maybe-emit-return)))))))
+
+ ((@call-with-current-continuation ,proc)
+ (case context
+ ((tail)
+ (comp-push proc)
+ (emit-code src (make-glil-call 'tail-call/cc 1)))
+ ((vals)
+ (comp-vals
+ (make-primcall src 'call-with-current-continuation args)
+ MVRA)
+ (maybe-emit-return))
+ ((push)
+ (comp-push proc)
+ (emit-code src (make-glil-call 'call/cc 1))
+ (maybe-emit-return))
+ ((drop)
+ ;; Fall back.
+ (comp-tail
+ (make-primcall src 'call-with-current-continuation args)))))
+
+ ;; A hack for variable-set, the opcode for which takes its args
+ ;; reversed, relative to the variable-set! function
+ ((variable-set! ,var ,val)
+ (comp-push val)
+ (comp-push var)
+ (emit-code src (make-glil-call 'variable-set 2))
+ (case context
+ ((tail push vals) (emit-code #f (make-glil-void))))
+ (maybe-emit-return))
+
+ (else
+ (cond
+ ((or (hash-ref *primcall-ops* (cons name (length args)))
+ (hash-ref *primcall-ops* name))
+ => (lambda (op)
+ (for-each comp-push args)
+ (emit-code src (make-glil-call op (length args)))
+ (case (instruction-pushes op)
+ ((0)
+ (case context
+ ((tail push vals) (emit-code #f (make-glil-void))))
+ (maybe-emit-return))
+ ((1)
+ (case context
+ ((drop) (emit-code #f (make-glil-call 'drop 1))))
+ (maybe-emit-return))
+ ((-1)
+ ;; A control instruction, like return/values. Here we
+ ;; just have to hope that the author of the tree-il
+ ;; knew what they were doing.
+ *unspecified*)
+ (else
+ (error "bad primitive op: too many pushes"
+ op (instruction-pushes op))))))
+ (else
+ ;; Fall back to the normal compilation strategy.
+ (comp-tail (make-call src (make-primitive-ref #f name) args)))))))
+
((<conditional> src test consequent alternate)
;; TEST
;; (br-if-not L1)
@@ -550,54 +517,33 @@
;; L1: alternate
;; L2:
(let ((L1 (make-label)) (L2 (make-label)))
- ;; need a pattern matcher
(record-case test
- ((<application> proc args)
- (record-case proc
- ((<primitive-ref> name)
- (let ((len (length args)))
- (cond
-
- ((and (eq? name 'eq?) (= len 2))
- (comp-push (car args))
- (comp-push (cadr args))
- (emit-branch src 'br-if-not-eq L1))
-
- ((and (eq? name 'null?) (= len 1))
- (comp-push (car args))
- (emit-branch src 'br-if-not-null L1))
-
- ((and (eq? name 'not) (= len 1))
- (let ((app (car args)))
- (record-case app
- ((<application> proc args)
- (let ((len (length args)))
- (record-case proc
- ((<primitive-ref> name)
- (cond
-
- ((and (eq? name 'eq?) (= len 2))
- (comp-push (car args))
- (comp-push (cadr args))
- (emit-branch src 'br-if-eq L1))
-
- ((and (eq? name 'null?) (= len 1))
- (comp-push (car args))
- (emit-branch src 'br-if-null L1))
-
- (else
- (comp-push app)
- (emit-branch src 'br-if L1))))
- (else
- (comp-push app)
- (emit-branch src 'br-if L1)))))
- (else
- (comp-push app)
- (emit-branch src 'br-if L1)))))
-
- (else
- (comp-push test)
- (emit-branch src 'br-if-not L1)))))
+ ((<primcall> name args)
+ (pmatch (cons name args)
+ ((eq? ,a ,b)
+ (comp-push a)
+ (comp-push b)
+ (emit-branch src 'br-if-not-eq L1))
+ ((null? ,x)
+ (comp-push x)
+ (emit-branch src 'br-if-not-null L1))
+ ((not ,x)
+ (record-case x
+ ((<primcall> name args)
+ (pmatch (cons name args)
+ ((eq? ,a ,b)
+ (comp-push a)
+ (comp-push b)
+ (emit-branch src 'br-if-eq L1))
+ ((null? ,x)
+ (comp-push x)
+ (emit-branch src 'br-if-null L1))
+ (else
+ (comp-push x)
+ (emit-branch src 'br-if L1))))
+ (else
+ (comp-push x)
+ (emit-branch src 'br-if L1))))
(else
(comp-push test)
(emit-branch src 'br-if-not L1))))
@@ -974,10 +920,10 @@
;; to have body's return value(s) on the stack while the unwinder runs,
;; then proceed with returning or dropping or what-have-you, interacting
;; with RA and MVRA. What have you, I say.
- ((<dynwind> src body winder unwinder)
+ ((<dynwind> src winder pre body post unwinder)
(comp-push winder)
(comp-push unwinder)
- (comp-drop (make-application src winder '()))
+ (comp-drop pre)
(emit-code #f (make-glil-call 'wind 2))
(case context
@@ -986,14 +932,14 @@
(comp-vals body MV)
;; one value: unwind...
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop (make-application src unwinder '()))
+ (comp-drop post)
;; ...and return the val
(emit-code #f (make-glil-call 'return 1))
(emit-label MV)
;; multiple values: unwind...
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop (make-application src unwinder '()))
+ (comp-drop post)
;; and return the values.
(emit-code #f (make-glil-call 'return/nvalues 1))))
@@ -1002,7 +948,7 @@
(comp-push body)
;; and unwind, leaving the val on the stack
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop (make-application src unwinder '())))
+ (comp-drop post))
((vals)
(let ((MV (make-label)))
@@ -1013,7 +959,7 @@
(emit-label MV)
;; multiple values: unwind...
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop (make-application src unwinder '()))
+ (comp-drop post)
;; and goto the MVRA.
(emit-branch #f 'br MVRA)))
@@ -1021,7 +967,7 @@
;; compile body, discarding values. then unwind...
(comp-drop body)
(emit-code #f (make-glil-call 'unwind 0))
- (comp-drop (make-application src unwinder '()))
+ (comp-drop post)
;; and fall through, or goto RA if there is one.
(if RA
(emit-branch #f 'br RA)))))
diff --git a/module/language/tree-il/debug.scm b/module/language/tree-il/debug.scm
index 78f132416..a32fc4153 100644
--- a/module/language/tree-il/debug.scm
+++ b/module/language/tree-il/debug.scm
@@ -215,9 +215,11 @@
(for-each (cut visit <> env) fluids)
(for-each (cut visit <> env) vals)
(visit body env))))
- (($ <dynwind> src winder body unwinder)
+ (($ <dynwind> src winder pre body post unwinder)
(visit winder env)
+ (visit pre env)
(visit body env)
+ (visit post env)
(visit unwinder env))
(($ <dynref> src fluid)
(visit fluid env))
@@ -228,21 +230,24 @@
(visit condition env)
(visit subsequent env)
(visit alternate env))
- (($ <application> src proc args)
+ (($ <primcall> src name args)
(cond
+ ((not (symbol? name))
+ (error "expected symbolic operator" exp))
((not (list? args))
(error "expected list of args" args))
(else
- (visit proc env)
(for-each (cut visit <> env) args))))
- (($ <sequence> src exps)
+ (($ <call> src proc args)
(cond
- ((not (list? exps))
- (error "expected list of exps" exp))
- ((null? exps)
- (error "expected more than one exp" exp))
+ ((not (list? args))
+ (error "expected list of args" args))
(else
- (for-each (cut visit <> env) exps))))
+ (visit proc env)
+ (for-each (cut visit <> env) args))))
+ (($ <seq> src head tail)
+ (visit head env)
+ (visit tail env))
(($ <prompt> src tag body handler)
(visit tag env)
(visit body env)
diff --git a/module/language/tree-il/fix-letrec.scm b/module/language/tree-il/fix-letrec.scm
index f387df193..f83d77e76 100644
--- a/module/language/tree-il/fix-letrec.scm
+++ b/module/language/tree-il/fix-letrec.scm
@@ -41,12 +41,11 @@
(and (simple-expression? test bound-vars simple-primitive?)
(simple-expression? consequent bound-vars simple-primitive?)
(simple-expression? alternate bound-vars simple-primitive?)))
- ((<sequence> exps)
- (and-map (lambda (x) (simple-expression? x bound-vars simple-primitive?))
- exps))
- ((<application> proc args)
- (and (primitive-ref? proc)
- (simple-primitive? (primitive-ref-name proc))
+ ((<seq> head tail)
+ (and (simple-expression? head bound-vars simple-primitive?)
+ (simple-expression? tail bound-vars simple-primitive?)))
+ ((<primcall> name args)
+ (and (simple-primitive? name)
;; FIXME: check arity?
(and-map (lambda (x)
(simple-expression? x bound-vars simple-primitive?))
@@ -191,7 +190,7 @@
;; expression, called for effect.
((<lexical-set> gensym exp)
(if (memq gensym unref)
- (make-sequence #f (list exp (make-void #f)))
+ (make-seq #f exp (make-void #f))
x))
((<letrec> src in-order? names gensyms vals body)
@@ -219,7 +218,7 @@
;; Bind lambdas using the fixpoint operator.
(make-fix
src (map cadr l) (map car l) (map caddr l)
- (make-sequence
+ (list->seq
src
(append
;; The right-hand-sides of the unreferenced
@@ -246,7 +245,7 @@
(let ((tmps (map (lambda (x) (gensym)) c)))
(make-let
#f (map cadr c) tmps (map caddr c)
- (make-sequence
+ (list->seq
#f
(map (lambda (x tmp)
(make-lexical-set
@@ -263,7 +262,7 @@
(let ((u (lookup unref))
(l (lookup lambda*))
(c (lookup complex)))
- (make-sequence
+ (list->seq
src
(append
;; unreferenced bindings, called for effect.
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 7aad3997a..9aac24cc1 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -108,9 +108,8 @@
(($ <primitive-ref>) #t)
(($ <module-ref>) #t)
(($ <toplevel-ref>) #t)
- (($ <application> _
- ($ <primitive-ref> _ (? singly-valued-primitive?))) #t)
- (($ <application> _ ($ <primitive-ref> _ 'values) (val)) #t)
+ (($ <primcall> _ (? singly-valued-primitive?)) #t)
+ (($ <primcall> _ 'values (val)) #t)
(($ <lambda>) #t)
(else #f)))
@@ -118,9 +117,7 @@
"Discard all but the first value of X."
(if (singly-valued-expression? x)
x
- (make-application (tree-il-src x)
- (make-primitive-ref #f 'values)
- (list x))))
+ (make-primcall (tree-il-src x) 'values (list x))))
;; Peval will do a one-pass analysis on the source program to determine
;; the set of assigned lexicals, and to identify unreferenced and
@@ -318,7 +315,7 @@
(%set-operand-residual-value!
op
(match val
- (($ <application> src ($ <primitive-ref> _ 'values) (first))
+ (($ <primcall> src 'values (first))
;; The continuation of a residualized binding does not need the
;; introduced `values' node, so undo the effects of truncation.
first)
@@ -386,18 +383,15 @@ top-level bindings from ENV and return the resulting expression."
(define local-toplevel-env
;; The top-level environment of the module being compiled.
- (match exp
- (($ <toplevel-define> _ name)
- (vhash-consq name #t env))
- (($ <sequence> _ exps)
- (fold (lambda (x r)
- (match x
- (($ <toplevel-define> _ name)
- (vhash-consq name #t r))
- (_ r)))
- env
- exps))
- (_ env)))
+ (let ()
+ (define (env-folder x env)
+ (match x
+ (($ <toplevel-define> _ name)
+ (vhash-consq name #t env))
+ (($ <seq> _ head tail)
+ (env-folder tail (env-folder head env)))
+ (_ env)))
+ (env-folder exp vlist-null)))
(define (local-toplevel? name)
(vhash-assq name local-toplevel-env))
@@ -445,7 +439,7 @@ top-level bindings from ENV and return the resulting expression."
(define* (residualize-lexical op #:optional ctx val)
(log 'residualize op)
(set-operand-residualize?! op #t)
- (if (memq ctx '(value values))
+ (if (eq? ctx 'value)
(set-operand-residual-value! op val))
(make-lexical-ref #f (var-name (operand-var op)) (operand-sym op)))
@@ -461,15 +455,13 @@ top-level bindings from ENV and return the resulting expression."
(values #t results))))
(lambda _
(values #f '()))))
-
(define (make-values src values)
(match values
((single) single) ; 1 value
((_ ...) ; 0, or 2 or more values
- (make-application src (make-primitive-ref src 'values)
- values))))
+ (make-primcall src 'values values))))
(define (residualize-call)
- (make-application src (make-primitive-ref #f name) args))
+ (make-primcall src name args))
(cond
((every const? args)
(let-values (((success? values)
@@ -511,13 +503,12 @@ top-level bindings from ENV and return the resulting expression."
($ <dynset>)) ;
(and (= (length names) 1)
(make-let src names gensyms (list exp) body)))
- (($ <application> src
- ($ <primitive-ref> _ (? singly-valued-primitive? name)))
+ (($ <primcall> src (? singly-valued-primitive? name))
(and (= (length names) 1)
(make-let src names gensyms (list exp) body)))
;; Statically-known number of values.
- (($ <application> src ($ <primitive-ref> _ 'values) vals)
+ (($ <primcall> src 'values vals)
(and (= (length names) (length vals))
(make-let src names gensyms vals body)))
@@ -525,7 +516,8 @@ top-level bindings from ENV and return the resulting expression."
(($ <conditional>) #f)
;; Bail on other applications.
- (($ <application>) #f)
+ (($ <call>) #f)
+ (($ <primcall>) #f)
;; Bail on prompt and abort.
(($ <prompt>) #f)
@@ -551,20 +543,17 @@ top-level bindings from ENV and return the resulting expression."
(make-let-values src exp
(make-lambda-case src2 req opt rest kw
inits gensyms body #f)))))
- (($ <dynwind> src winder body unwinder)
+ (($ <dynwind> src winder pre body post unwinder)
(let ((body (loop body)))
(and body
- (make-dynwind src winder body unwinder))))
+ (make-dynwind src winder pre body post unwinder))))
(($ <dynlet> src fluids vals body)
(let ((body (loop body)))
(and body
(make-dynlet src fluids vals body))))
- (($ <sequence> src exps)
- (match exps
- ((head ... tail)
- (let ((tail (loop tail)))
- (and tail
- (make-sequence src (append head (list tail)))))))))))
+ (($ <seq> src head tail)
+ (let ((tail (loop tail)))
+ (and tail (make-seq src head tail)))))))
(define (constant-expression? x)
;; Return true if X is constant, for the purposes of copying or
@@ -585,19 +574,20 @@ top-level bindings from ENV and return the resulting expression."
(($ <primitive-ref>) #t)
(($ <conditional> _ condition subsequent alternate)
(and (loop condition) (loop subsequent) (loop alternate)))
- (($ <application> _ ($ <primitive-ref> _ 'values) exps)
+ (($ <primcall> _ 'values exps)
(and (not (null? exps))
(every loop exps)))
- (($ <application> _ ($ <primitive-ref> _ name) args)
+ (($ <primcall> _ name args)
(and (effect-free-primitive? name)
(not (constructor-primitive? name))
- (not (accessor-primitive? name))
(types-check? name args)
- (every loop args)))
- (($ <application> _ ($ <lambda> _ _ body) args)
+ (if (accessor-primitive? name)
+ (every const? args)
+ (every loop args))))
+ (($ <call> _ ($ <lambda> _ _ body) args)
(and (loop body) (every loop args)))
- (($ <sequence> _ exps)
- (every loop exps))
+ (($ <seq> _ head tail)
+ (and (loop head) (loop tail)))
(($ <let> _ _ syms vals body)
(and (not (any assigned-lexical? syms))
(every loop vals) (loop body)))
@@ -646,7 +636,7 @@ top-level bindings from ENV and return the resulting expression."
(if (null? effects)
body
(let ((effect-vals (map operand-residual-value effects)))
- (make-sequence #f (reverse (cons body effect-vals)))))))
+ (list->seq #f (reverse (cons body effect-vals)))))))
(if (null? values)
body
(let ((values (reverse values)))
@@ -833,7 +823,7 @@ top-level bindings from ENV and return the resulting expression."
(let ((exp (for-effect exp)))
(if (void? exp)
exp
- (make-sequence src (list exp (make-void #f)))))
+ (make-seq src exp (make-void #f))))
(begin
(set-operand-residualize?! op #t)
(make-lexical-set src name (operand-sym op) (for-value exp))))))
@@ -847,14 +837,14 @@ top-level bindings from ENV and return the resulting expression."
(body (loop body env counter ctx)))
(cond
((const? body)
- (for-tail (make-sequence src (append vals (list body)))))
+ (for-tail (list->seq src (append vals (list body)))))
((and (lexical-ref? body)
(memq (lexical-ref-gensym body) new))
(let ((sym (lexical-ref-gensym body))
(pairs (map cons new vals)))
;; (let ((x foo) (y bar) ...) x) => (begin bar ... foo)
(for-tail
- (make-sequence
+ (list->seq
src
(append (map cdr (alist-delete sym pairs eq?))
(list (assq-ref pairs sym)))))))
@@ -911,40 +901,10 @@ top-level bindings from ENV and return the resulting expression."
(else #f)))
(_ #f))
(make-let-values lv-src producer (for-tail consumer)))))
- (($ <dynwind> src winder body unwinder)
- (let ((pre (for-value winder))
- (body (for-tail body))
- (post (for-value unwinder)))
- (cond
- ((not (constant-expression? pre))
- (cond
- ((not (constant-expression? post))
- (let ((pre-sym (gensym "pre-")) (post-sym (gensym "post-")))
- (record-new-temporary! 'pre pre-sym 1)
- (record-new-temporary! 'post post-sym 1)
- (make-let src '(pre post) (list pre-sym post-sym) (list pre post)
- (make-dynwind src
- (make-lexical-ref #f 'pre pre-sym)
- body
- (make-lexical-ref #f 'post post-sym)))))
- (else
- (let ((pre-sym (gensym "pre-")))
- (record-new-temporary! 'pre pre-sym 1)
- (make-let src '(pre) (list pre-sym) (list pre)
- (make-dynwind src
- (make-lexical-ref #f 'pre pre-sym)
- body
- post))))))
- ((not (constant-expression? post))
- (let ((post-sym (gensym "post-")))
- (record-new-temporary! 'post post-sym 1)
- (make-let src '(post) (list post-sym) (list post)
- (make-dynwind src
- pre
- body
- (make-lexical-ref #f 'post post-sym)))))
- (else
- (make-dynwind src pre body post)))))
+ (($ <dynwind> src winder pre body post unwinder)
+ (make-dynwind src (for-value winder) (for-effect pre)
+ (for-tail body)
+ (for-effect post) (for-value unwinder)))
(($ <dynlet> src fluids vals body)
(make-dynlet src (map for-value fluids) (map for-value vals)
(for-tail body)))
@@ -953,12 +913,7 @@ top-level bindings from ENV and return the resulting expression."
(($ <dynset> src fluid exp)
(make-dynset src (for-value fluid) (for-value exp)))
(($ <toplevel-ref> src (? effect-free-primitive? name))
- (if (local-toplevel? name)
- exp
- (let ((exp (resolve-primitives! exp cenv)))
- (if (primitive-ref? exp)
- (for-tail exp)
- exp))))
+ exp)
(($ <toplevel-ref>)
;; todo: open private local bindings.
exp)
@@ -993,17 +948,59 @@ top-level bindings from ENV and return the resulting expression."
(make-conditional src condition
(for-tail subsequent)
(for-tail alternate)))))
- (($ <application> src
- ($ <primitive-ref> _ '@call-with-values)
+ (($ <primcall> src '@call-with-values
(producer
($ <lambda> _ _
(and consumer
;; No optional or kwargs.
($ <lambda-case>
_ req #f rest #f () gensyms body #f)))))
- (for-tail (make-let-values src (make-application src producer '())
+ (for-tail (make-let-values src (make-call src producer '())
consumer)))
- (($ <application> src ($ <primitive-ref> _ 'values) exps)
+ (($ <primcall> src 'dynamic-wind (w thunk u))
+ (for-tail
+ (cond
+ ((not (constant-expression? w))
+ (cond
+ ((not (constant-expression? u))
+ (let ((w-sym (gensym "w ")) (u-sym (gensym "u ")))
+ (record-new-temporary! 'w w-sym 2)
+ (record-new-temporary! 'u u-sym 2)
+ (make-let src '(w u) (list w-sym u-sym) (list w u)
+ (make-dynwind
+ src
+ (make-lexical-ref #f 'w w-sym)
+ (make-call #f (make-lexical-ref #f 'w w-sym) '())
+ (make-call #f thunk '())
+ (make-call #f (make-lexical-ref #f 'u u-sym) '())
+ (make-lexical-ref #f 'u u-sym)))))
+ (else
+ (let ((w-sym (gensym "w ")))
+ (record-new-temporary! 'w w-sym 2)
+ (make-let src '(w) (list w-sym) (list w)
+ (make-dynwind
+ src
+ (make-lexical-ref #f 'w w-sym)
+ (make-call #f (make-lexical-ref #f 'w w-sym) '())
+ (make-call #f thunk '())
+ (make-call #f u '())
+ u))))))
+ ((not (constant-expression? u))
+ (let ((u-sym (gensym "u ")))
+ (record-new-temporary! 'u u-sym 2)
+ (make-let src '(u) (list u-sym) (list u)
+ (make-dynwind
+ src
+ w
+ (make-call #f w '())
+ (make-call #f thunk '())
+ (make-call #f (make-lexical-ref #f 'u u-sym) '())
+ (make-lexical-ref #f 'u u-sym)))))
+ (else
+ (make-dynwind src w (make-call #f w '()) (make-call #f thunk '())
+ (make-call #f u '()) u)))))
+
+ (($ <primcall> src 'values exps)
(cond
((null? exps)
(if (eq? ctx 'effect)
@@ -1015,113 +1012,109 @@ top-level bindings from ENV and return the resulting expression."
((value test effect) #t)
(else (null? (cdr vals))))
(every singly-valued-expression? vals))
- (for-tail (make-sequence src (append (cdr vals) (list (car vals)))))
- (make-application src (make-primitive-ref #f 'values) vals))))))
- (($ <application> src orig-proc orig-args)
+ (for-tail (list->seq src (append (cdr vals) (list (car vals)))))
+ (make-primcall src 'values vals))))))
+
+ (($ <primcall> src (? constructor-primitive? name) args)
+ (cond
+ ((and (memq ctx '(effect test))
+ (match (cons name args)
+ ((or ('cons _ _)
+ ('list . _)
+ ('vector . _)
+ ('make-prompt-tag)
+ ('make-prompt-tag ($ <const> _ (? string?))))
+ #t)
+ (_ #f)))
+ ;; Some expressions can be folded without visiting the
+ ;; arguments for value.
+ (let ((res (if (eq? ctx 'effect)
+ (make-void #f)
+ (make-const #f #t))))
+ (for-tail (list->seq src (append args (list res))))))
+ (else
+ (match (cons name (map for-value args))
+ (('cons x ($ <const> _ (? (cut eq? <> '()))))
+ (make-primcall src 'list (list x)))
+ (('cons x ($ <primcall> _ 'list elts))
+ (make-primcall src 'list (cons x elts)))
+ ((name . args)
+ (make-primcall src name args))))))
+
+ (($ <primcall> src (? accessor-primitive? name) args)
+ (match (cons name (map for-value args))
+ ;; FIXME: these for-tail recursions could take place outside
+ ;; an effort counter.
+ (('car ($ <primcall> src 'cons (head tail)))
+ (for-tail (make-seq src tail head)))
+ (('cdr ($ <primcall> src 'cons (head tail)))
+ (for-tail (make-seq src head tail)))
+ (('car ($ <primcall> src 'list (head . tail)))
+ (for-tail (list->seq src (append tail (list head)))))
+ (('cdr ($ <primcall> src 'list (head . tail)))
+ (for-tail (make-seq src head (make-primcall #f 'list tail))))
+
+ (('car ($ <const> src (head . tail)))
+ (for-tail (make-const src head)))
+ (('cdr ($ <const> src (head . tail)))
+ (for-tail (make-const src tail)))
+ (((or 'memq 'memv) k ($ <const> _ (elts ...)))
+ ;; FIXME: factor
+ (case ctx
+ ((effect)
+ (for-tail
+ (make-seq src k (make-void #f))))
+ ((test)
+ (cond
+ ((const? k)
+ ;; A shortcut. The `else' case would handle it, but
+ ;; this way is faster.
+ (let ((member (case name ((memq) memq) ((memv) memv))))
+ (make-const #f (and (member (const-exp k) elts) #t))))
+ ((null? elts)
+ (for-tail
+ (make-seq src k (make-const #f #f))))
+ (else
+ (let ((t (gensym "t "))
+ (eq (if (eq? name 'memq) 'eq? 'eqv?)))
+ (record-new-temporary! 't t (length elts))
+ (for-tail
+ (make-let
+ src (list 't) (list t) (list k)
+ (let lp ((elts elts))
+ (define test
+ (make-primcall #f eq
+ (list (make-lexical-ref #f 't t)
+ (make-const #f (car elts)))))
+ (if (null? (cdr elts))
+ test
+ (make-conditional src test
+ (make-const #f #t)
+ (lp (cdr elts)))))))))))
+ (else
+ (cond
+ ((const? k)
+ (let ((member (case name ((memq) memq) ((memv) memv))))
+ (make-const #f (member (const-exp k) elts))))
+ ((null? elts)
+ (for-tail (make-seq src k (make-const #f #f))))
+ (else
+ (make-primcall src name (list k (make-const #f elts))))))))
+ ((name . args)
+ (fold-constants src name args ctx))))
+
+ (($ <primcall> src (? effect-free-primitive? name) args)
+ (fold-constants src name (map for-value args) ctx))
+
+ (($ <primcall> src name args)
+ (make-primcall src name (map for-value args)))
+
+ (($ <call> src orig-proc orig-args)
;; todo: augment the global env with specialized functions
(let ((proc (visit orig-proc 'operator)))
(match proc
- (($ <primitive-ref> _ (? constructor-primitive? name))
- (cond
- ((and (memq ctx '(effect test))
- (match (cons name orig-args)
- ((or ('cons _ _)
- ('list . _)
- ('vector . _)
- ('make-prompt-tag)
- ('make-prompt-tag ($ <const> _ (? string?))))
- #t)
- (_ #f)))
- ;; Some expressions can be folded without visiting the
- ;; arguments for value.
- (let ((res (if (eq? ctx 'effect)
- (make-void #f)
- (make-const #f #t))))
- (for-tail (make-sequence src (append orig-args (list res))))))
- (else
- (match (cons name (map for-value orig-args))
- (('cons head tail)
- (match tail
- (($ <const> src (? (cut eq? <> '())))
- (make-application src (make-primitive-ref #f 'list)
- (list head)))
- (($ <application> src ($ <primitive-ref> _ 'list) elts)
- (make-application src (make-primitive-ref #f 'list)
- (cons head elts)))
- (_ (make-application src proc (list head tail)))))
- ((_ . args)
- (make-application src proc args))))))
- (($ <primitive-ref> _ (? accessor-primitive? name))
- (match (cons name (map for-value orig-args))
- ;; FIXME: these for-tail recursions could take place outside
- ;; an effort counter.
- (('car ($ <application> src ($ <primitive-ref> _ 'cons) (head tail)))
- (for-tail (make-sequence src (list tail head))))
- (('cdr ($ <application> src ($ <primitive-ref> _ 'cons) (head tail)))
- (for-tail (make-sequence src (list head tail))))
- (('car ($ <application> src ($ <primitive-ref> _ 'list) (head . tail)))
- (for-tail (make-sequence src (append tail (list head)))))
- (('cdr ($ <application> src ($ <primitive-ref> _ 'list) (head . tail)))
- (for-tail (make-sequence
- src
- (list head
- (make-application
- src (make-primitive-ref #f 'list) tail)))))
-
- (('car ($ <const> src (head . tail)))
- (for-tail (make-const src head)))
- (('cdr ($ <const> src (head . tail)))
- (for-tail (make-const src tail)))
- (((or 'memq 'memv) k ($ <const> _ (elts ...)))
- ;; FIXME: factor
- (case ctx
- ((effect)
- (for-tail
- (make-sequence src (list k (make-void #f)))))
- ((test)
- (cond
- ((const? k)
- ;; A shortcut. The `else' case would handle it, but
- ;; this way is faster.
- (let ((member (case name ((memq) memq) ((memv) memv))))
- (make-const #f (and (member (const-exp k) elts) #t))))
- ((null? elts)
- (for-tail
- (make-sequence src (list k (make-const #f #f)))))
- (else
- (let ((t (gensym "t-"))
- (eq (if (eq? name 'memq) 'eq? 'eqv?)))
- (record-new-temporary! 't t (length elts))
- (for-tail
- (make-let
- src (list 't) (list t) (list k)
- (let lp ((elts elts))
- (define test
- (make-application
- #f (make-primitive-ref #f eq)
- (list (make-lexical-ref #f 't t)
- (make-const #f (car elts)))))
- (if (null? (cdr elts))
- test
- (make-conditional src test
- (make-const #f #t)
- (lp (cdr elts)))))))))))
- (else
- (cond
- ((const? k)
- (let ((member (case name ((memq) memq) ((memv) memv))))
- (make-const #f (member (const-exp k) elts))))
- ((null? elts)
- (for-tail (make-sequence src (list k (make-const #f #f)))))
- (else
- (make-application src proc (list k (make-const #f elts))))))))
- ((_ . args)
- (or (fold-constants src name args ctx)
- (make-application src proc args)))))
- (($ <primitive-ref> _ (? effect-free-primitive? name))
- (let ((args (map for-value orig-args)))
- (or (fold-constants src name args ctx)
- (make-application src proc args))))
+ (($ <primitive-ref> _ name)
+ (for-tail (make-primcall src name orig-args)))
(($ <lambda> _ _
($ <lambda-case> _ req opt #f #f inits gensyms body #f))
;; Simple case: no rest, no keyword arguments.
@@ -1133,8 +1126,7 @@ top-level bindings from ENV and return the resulting expression."
(cond
((or (< nargs nreq) (> nargs (+ nreq nopt)))
;; An error, or effecting arguments.
- (make-application src (for-call orig-proc)
- (map for-value orig-args)))
+ (make-call src (for-call orig-proc) (map for-value orig-args)))
((or (and=> (find-counter key counter) counter-recursive?)
(lambda? orig-proc))
;; A recursive call, or a lambda in the operator
@@ -1171,8 +1163,8 @@ top-level bindings from ENV and return the resulting expression."
(let/ec k
(define (abort)
(log 'inline-abort exp)
- (k (make-application src (for-call orig-proc)
- (map for-value orig-args))))
+ (k (make-call src (for-call orig-proc)
+ (map for-value orig-args))))
(define new-counter
(cond
;; These first two cases will transfer effort
@@ -1208,8 +1200,7 @@ top-level bindings from ENV and return the resulting expression."
(log 'inline-end result exp)
result)))))
(_
- (make-application src (for-call orig-proc)
- (map for-value orig-args))))))
+ (make-call src (for-call orig-proc) (map for-value orig-args))))))
(($ <lambda> src meta body)
(case ctx
((effect) (make-void #f))
@@ -1234,24 +1225,17 @@ top-level bindings from ENV and return the resulting expression."
new
(loop body env counter ctx)
(and alt (for-tail alt)))))
- (($ <sequence> src exps)
- (let lp ((exps exps) (effects '()))
- (match exps
- ((last)
- (if (null? effects)
- (for-tail last)
- (make-sequence
- src
- (reverse (cons (for-tail last) effects)))))
- ((head . rest)
- (let ((head (for-effect head)))
- (cond
- ((sequence? head)
- (lp (append (sequence-exps head) rest) effects))
- ((void? head)
- (lp rest effects))
- (else
- (lp rest (cons head effects)))))))))
+ (($ <seq> src head tail)
+ (let ((head (for-effect head))
+ (tail (for-tail tail)))
+ (if (void? head)
+ tail
+ (make-seq src
+ (if (and (seq? head)
+ (void? (seq-tail head)))
+ (seq-head head)
+ head)
+ tail))))
(($ <prompt> src tag body handler)
(define (singly-used-definition x)
(cond
@@ -1263,8 +1247,7 @@ top-level bindings from ENV and return the resulting expression."
(singly-used-definition (visit-operand x counter 'value 10 10))))
(else x)))
(match (singly-used-definition tag)
- (($ <application> _ ($ <primitive-ref> _ 'make-prompt-tag)
- (or () ((? constant-expression?))))
+ (($ <primcall> _ 'make-prompt-tag (or () ((? constant-expression?))))
;; There is no way that an <abort> could know the tag
;; for this <prompt>, so we can elide the <prompt>
;; entirely.
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 23f5df5f4..f192c4fc3 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -60,7 +60,7 @@
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
- vector-ref vector-set!
+ vector-length vector-ref vector-set!
variable-ref variable-set!
variable-bound?
@@ -141,7 +141,7 @@
+ * - / 1- 1+ quotient remainder modulo
not
pair? null? list? symbol? vector? struct? string?
- string-length
+ string-length vector-length
;; These all should get expanded out by expand-primitives!.
caar cadr cdar cddr
caaar caadr cadar caddr cdaar cdadr cddar cdddr
@@ -232,12 +232,25 @@
(hashq-ref *singly-valued-primitive-table* prim))
(define (resolve-primitives! x mod)
+ (define local-definitions
+ (make-hash-table))
+
+ (let collect-local-definitions ((x x))
+ (record-case x
+ ((<toplevel-define> name)
+ (hashq-set! local-definitions name #t))
+ ((<seq> head tail)
+ (collect-local-definitions head)
+ (collect-local-definitions tail))
+ (else #f)))
+
(post-order!
(lambda (x)
(record-case x
((<toplevel-ref> src name)
- (and=> (hashq-ref *interesting-primitive-vars*
- (module-variable mod name))
+ (and=> (and (not (hashq-ref local-definitions name))
+ (hashq-ref *interesting-primitive-vars*
+ (module-variable mod name)))
(lambda (name) (make-primitive-ref src name))))
((<module-ref> src mod name public?)
;; for the moment, we're disabling primitive resolution for
@@ -247,6 +260,9 @@
(and=> (hashq-ref *interesting-primitive-vars*
(module-variable m name))
(lambda (name) (make-primitive-ref src name))))))
+ ((<call> src proc args)
+ (and (primitive-ref? proc)
+ (make-primcall src (primitive-ref-name proc) args)))
(else #f)))
x))
@@ -258,11 +274,9 @@
(pre-order!
(lambda (x)
(record-case x
- ((<application> src proc args)
- (and (primitive-ref? proc)
- (let ((expand (hashq-ref *primitive-expand-table*
- (primitive-ref-name proc))))
- (and expand (apply expand src args)))))
+ ((<primcall> src name args)
+ (let ((expand (hashq-ref *primitive-expand-table* name)))
+ (and expand (apply expand src args))))
(else #f)))
x))
@@ -278,8 +292,8 @@
(lp (cdr in)
(cons (if (eq? (caar in) 'quote)
`(make-const src ,@(cdar in))
- `(make-application src (make-primitive-ref src ',(caar in))
- ,(inline-args (cdar in))))
+ `(make-primcall src ',(caar in)
+ ,(inline-args (cdar in))))
out)))
((symbol? (car in))
;; assume it's locally bound
@@ -297,8 +311,8 @@
,(consequent then)
,(consequent else)))
(else
- `(make-application src (make-primitive-ref src ',(car exp))
- ,(inline-args (cdr exp))))))
+ `(make-primcall src ',(car exp)
+ ,(inline-args (cdr exp))))))
((symbol? exp)
;; assume locally bound
exp)
@@ -470,25 +484,6 @@
(bytevector-ieee-double-native-set! vec (* i 8) x))
(hashq-set! *primitive-expand-table*
- 'dynamic-wind
- (case-lambda
- ((src pre thunk post)
- (let ((PRE (gensym "pre-"))
- (THUNK (gensym "thunk-"))
- (POST (gensym "post-")))
- (make-let
- src
- '(pre thunk post)
- (list PRE THUNK POST)
- (list pre thunk post)
- (make-dynwind
- src
- (make-lexical-ref #f 'pre PRE)
- (make-application #f (make-lexical-ref #f 'thunk THUNK) '())
- (make-lexical-ref #f 'post POST)))))
- (else #f)))
-
-(hashq-set! *primitive-expand-table*
'@dynamic-wind
(case-lambda
((src pre expr post)
@@ -502,7 +497,9 @@
(make-dynwind
src
(make-lexical-ref #f 'pre PRE)
+ (make-call #f (make-lexical-ref #f 'pre PRE) '())
expr
+ (make-call #f (make-lexical-ref #f 'post POST) '())
(make-lexical-ref #f 'post POST)))))))
(hashq-set! *primitive-expand-table*
@@ -528,9 +525,9 @@
;; trickery here.
(make-lambda-case
(tree-il-src handler) '() #f 'args #f '() (list args-sym)
- (make-application #f (make-primitive-ref #f 'apply)
- (list handler
- (make-lexical-ref #f 'args args-sym)))
+ (make-primcall #f 'apply
+ (list handler
+ (make-lexical-ref #f 'args args-sym)))
#f))))
(else #f)))
@@ -544,14 +541,14 @@
((lambda? handler)
(let ((args-sym (gensym)))
(make-prompt
- src tag (make-application #f thunk '())
+ src tag (make-call #f thunk '())
;; If handler itself is a lambda, the inliner can do some
;; trickery here.
(make-lambda-case
(tree-il-src handler) '() #f 'args #f '() (list args-sym)
- (make-application #f (make-primitive-ref #f 'apply)
- (list handler
- (make-lexical-ref #f 'args args-sym)))
+ (make-primcall #f 'apply
+ (list handler
+ (make-lexical-ref #f 'args args-sym)))
#f))))
(else #f)))
(else #f)))
diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm
index 38e6d311c..3ad372709 100644
--- a/module/language/tree-il/spec.scm
+++ b/module/language/tree-il/spec.scm
@@ -1,6 +1,6 @@
;;; Tree Intermediate Language
-;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011 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
@@ -33,7 +33,9 @@
(pmatch exps
(() (make-void #f))
((,x) x)
- (else (make-sequence #f exps))))
+ ((,x . ,rest)
+ (make-seq #f x (join rest env)))
+ (else (error "what!" exps env))))
(define-language tree-il
#:title "Tree Intermediate Language"
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index e4424f382..cd811b3bb 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -26,54 +26,112 @@
;;;;
(define-module (oop goops)
- :use-module (srfi srfi-1)
- :export-syntax (define-class class standard-define-class
- define-generic define-accessor define-method
- define-extended-generic define-extended-generics
- method)
- :export (is-a? class-of
- ensure-metaclass ensure-metaclass-with-supers
- make-class
- make-generic ensure-generic
- make-extended-generic
- make-accessor ensure-accessor
- add-method!
- class-slot-ref class-slot-set! slot-unbound slot-missing
- slot-definition-name slot-definition-options
- slot-definition-allocation
- slot-definition-getter slot-definition-setter
- slot-definition-accessor
- slot-definition-init-value slot-definition-init-form
- slot-definition-init-thunk slot-definition-init-keyword
- slot-init-function class-slot-definition
- method-source
- compute-cpl compute-std-cpl compute-get-n-set compute-slots
- compute-getter-method compute-setter-method
- allocate-instance initialize make-instance make
- no-next-method no-applicable-method no-method
- change-class update-instance-for-different-class
- shallow-clone deep-clone
- class-redefinition
- apply-generic apply-method apply-methods
- compute-applicable-methods %compute-applicable-methods
- method-more-specific? sort-applicable-methods
- class-subclasses class-methods
- goops-error
- min-fixnum max-fixnum
- ;;; *fixme* Should go into goops.c
- instance? slot-ref-using-class
- slot-set-using-class! slot-bound-using-class?
- slot-exists-using-class? slot-ref slot-set! slot-bound?
- class-name class-direct-supers class-direct-subclasses
- class-direct-methods class-direct-slots class-precedence-list
- class-slots
- generic-function-name
- generic-function-methods method-generic-function
- method-specializers method-formals
- primitive-generic-generic enable-primitive-generic!
- method-procedure accessor-method-slot-definition
- slot-exists? make find-method get-keyword)
- :no-backtrace)
+ #:use-module (srfi srfi-1)
+ #:export-syntax (define-class class standard-define-class
+ define-generic define-accessor define-method
+ define-extended-generic define-extended-generics
+ method)
+ #:export ( ;; The root of everything.
+ <top>
+ <class> <object>
+
+ ;; Slot types.
+ <foreign-slot> <protected-slot> <hidden-slot> <opaque-slot>
+ <read-only-slot> <self-slot> <protected-opaque-slot>
+ <protected-hidden-slot> <protected-read-only-slot>
+ <scm-slot> <int-slot> <float-slot> <double-slot>
+
+ ;; Methods are implementations of generic functions.
+ <method> <accessor-method>
+
+ ;; Applicable objects, either procedures or applicable structs.
+ <procedure-class> <applicable>
+ <procedure> <primitive-generic>
+
+ ;; Applicable structs.
+ <applicable-struct-class>
+ <applicable-struct>
+ <generic> <extended-generic>
+ <generic-with-setter> <extended-generic-with-setter>
+ <accessor> <extended-accessor>
+
+ ;; Types with their own allocated typecodes.
+ <boolean> <char> <list> <pair> <null> <string> <symbol>
+ <vector> <bytevector> <uvec> <foreign> <hashtable>
+ <fluid> <dynamic-state> <frame> <objcode> <vm> <vm-continuation>
+
+ ;; Numbers.
+ <number> <complex> <real> <integer> <fraction>
+
+ ;; Unknown.
+ <unknown>
+
+ ;; Particular SMOB data types. All SMOB types have
+ ;; corresponding classes, which may be obtained via class-of,
+ ;; once you have an instance. Perhaps FIXME to provide a
+ ;; smob-type-name->class procedure.
+ <arbiter> <promise> <thread> <mutex> <condition-variable>
+ <regexp> <hook> <bitvector> <random-state> <async>
+ <directory> <keyword> <array> <character-set>
+ <dynamic-object> <guardian> <macro>
+
+ ;; Modules.
+ <module>
+
+ ;; Ports.
+ <port> <input-port> <output-port> <input-output-port>
+
+ ;; Like SMOB types, all port types have their own classes,
+ ;; which can be accessed via `class-of' once you have an
+ ;; instance. Here we export bindings just for file ports.
+ <file-port>
+ <file-input-port> <file-output-port> <file-input-output-port>
+
+ is-a? class-of
+ ensure-metaclass ensure-metaclass-with-supers
+ make-class
+ make-generic ensure-generic
+ make-extended-generic
+ make-accessor ensure-accessor
+ add-method!
+ class-slot-ref class-slot-set! slot-unbound slot-missing
+ slot-definition-name slot-definition-options
+ slot-definition-allocation
+
+ slot-definition-getter slot-definition-setter
+ slot-definition-accessor
+ slot-definition-init-value slot-definition-init-form
+ slot-definition-init-thunk slot-definition-init-keyword
+ slot-init-function class-slot-definition
+ method-source
+ compute-cpl compute-std-cpl compute-get-n-set compute-slots
+ compute-getter-method compute-setter-method
+ allocate-instance initialize make-instance make
+ no-next-method no-applicable-method no-method
+ change-class update-instance-for-different-class
+ shallow-clone deep-clone
+ class-redefinition
+ apply-generic apply-method apply-methods
+ compute-applicable-methods %compute-applicable-methods
+ method-more-specific? sort-applicable-methods
+ class-subclasses class-methods
+ goops-error
+ min-fixnum max-fixnum
+
+;;; *fixme* Should go into goops.c
+ instance? slot-ref-using-class
+ slot-set-using-class! slot-bound-using-class?
+ slot-exists-using-class? slot-ref slot-set! slot-bound?
+ class-name class-direct-supers class-direct-subclasses
+ class-direct-methods class-direct-slots class-precedence-list
+ class-slots
+ generic-function-name
+ generic-function-methods method-generic-function
+ method-specializers method-formals
+ primitive-generic-generic enable-primitive-generic!
+ method-procedure accessor-method-slot-definition
+ slot-exists? make find-method get-keyword)
+ #:no-backtrace)
(define *goops-module* (current-module))
@@ -97,6 +155,7 @@
(oop goops compile))
+;; FIXME: deprecate.
(eval-when (eval load compile)
(define min-fixnum (- (expt 2 29)))
(define max-fixnum (- (expt 2 29) 1)))
@@ -815,6 +874,20 @@
;;; Handling of duplicate bindings in the module system
;;;
+(define (find-subclass super name)
+ (let lp ((classes (class-direct-subclasses super)))
+ (cond
+ ((null? classes)
+ (error "class not found" name))
+ ((and (slot-bound? (car classes) 'name)
+ (eq? (class-name (car classes)) name))
+ (car classes))
+ (else
+ (lp (cdr classes))))))
+
+;; A record type.
+(define <module> (find-subclass <top> '<module>))
+
(define-method (merge-generics (module <module>)
(name <symbol>)
(int1 <module>)
@@ -1660,3 +1733,34 @@
;; Tell C code that the main bulk of Goops has been loaded
(%goops-loaded)
+
+
+
+
+;;;
+;;; {SMOB and port classes}
+;;;
+
+(define <arbiter> (find-subclass <top> '<arbiter>))
+(define <promise> (find-subclass <top> '<promise>))
+(define <thread> (find-subclass <top> '<thread>))
+(define <mutex> (find-subclass <top> '<mutex>))
+(define <condition-variable> (find-subclass <top> '<condition-variable>))
+(define <regexp> (find-subclass <top> '<regexp>))
+(define <hook> (find-subclass <top> '<hook>))
+(define <bitvector> (find-subclass <top> '<bitvector>))
+(define <random-state> (find-subclass <top> '<random-state>))
+(define <async> (find-subclass <top> '<async>))
+(define <directory> (find-subclass <top> '<directory>))
+(define <keyword> (find-subclass <top> '<keyword>))
+(define <array> (find-subclass <top> '<array>))
+(define <character-set> (find-subclass <top> '<character-set>))
+(define <dynamic-object> (find-subclass <top> '<dynamic-object>))
+(define <guardian> (find-subclass <applicable> '<guardian>))
+(define <macro> (find-subclass <top> '<macro>))
+
+(define (define-class-subtree class)
+ (define! (class-name class) class)
+ (for-each define-class-subtree (class-direct-subclasses class)))
+
+(define-class-subtree (find-subclass <port> '<file-port>))
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index d2b9c9420..8f86bce57 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -48,14 +48,14 @@
;; The vtable of all condition types.
;; vtable fields: vtable, self, printer
;; user fields: id, parent, all-field-names
- (make-vtable-vtable "prprpr" 0
- (lambda (ct port)
- (if (eq? ct %condition-type-vtable)
- (display "#<condition-type-vtable>")
- (format port "#<condition-type ~a ~a>"
- (condition-type-id ct)
- (number->string (object-address ct)
- 16))))))
+ (let ((s (make-vtable (string-append standard-vtable-fields "prprpr")
+ (lambda (ct port)
+ (format port "#<condition-type ~a ~a>"
+ (condition-type-id ct)
+ (number->string (object-address ct)
+ 16))))))
+ (set-struct-vtable-name! s 'condition-type)
+ s))
(define (%make-condition-type layout id parent all-fields)
(let ((struct (make-struct %condition-type-vtable 0
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 37f9b41ac..e6e965545 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -192,10 +192,6 @@ which does the reverse. PRINT must name a user-defined object printer."
;; PTR1 == PTR2 <-> (eq? (wrap PTR1) (wrap PTR2)).
(let ((ptr->obj (make-weak-value-hash-table 3000)))
(lambda (ptr)
- ;; XXX: We can't use `hash-create-handle!' +
- ;; `set-cdr!' here because the former would create a
- ;; weak-cdr pair but the latter wouldn't register a
- ;; disappearing link (see `scm_hash_fn_set_x'.)
(or (hash-ref ptr->obj ptr)
(let ((o (%wrap ptr)))
(hash-set! ptr->obj ptr o)