diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/boot-9.scm | 65 | ||||
-rw-r--r-- | module/ice-9/deprecated.scm | 866 | ||||
-rw-r--r-- | module/ice-9/eval.scm | 15 | ||||
-rw-r--r-- | module/ice-9/local-eval.scm | 6 | ||||
-rw-r--r-- | module/ice-9/psyntax-pp.scm | 36200 | ||||
-rw-r--r-- | module/ice-9/psyntax.scm | 1131 | ||||
-rw-r--r-- | module/ice-9/weak-vector.scm | 15 | ||||
-rw-r--r-- | module/language/brainfuck/compile-tree-il.scm | 54 | ||||
-rw-r--r-- | module/language/ecmascript/compile-tree-il.scm | 172 | ||||
-rw-r--r-- | module/language/elisp/compile-tree-il.scm | 207 | ||||
-rw-r--r-- | module/language/tree-il.scm | 163 | ||||
-rw-r--r-- | module/language/tree-il/analyze.scm | 70 | ||||
-rw-r--r-- | module/language/tree-il/canonicalize.scm | 14 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 438 | ||||
-rw-r--r-- | module/language/tree-il/debug.scm | 23 | ||||
-rw-r--r-- | module/language/tree-il/fix-letrec.scm | 19 | ||||
-rw-r--r-- | module/language/tree-il/peval.scm | 425 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 75 | ||||
-rw-r--r-- | module/language/tree-il/spec.scm | 6 | ||||
-rw-r--r-- | module/oop/goops.scm | 200 | ||||
-rw-r--r-- | module/srfi/srfi-35.scm | 16 | ||||
-rw-r--r-- | module/system/foreign.scm | 4 |
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) |