(eval-when (compile) (set-current-module (resolve-module (quote (guile))))) (if #f #f) (letrec ((and-map*1697 (lambda (f1737 first1736 . rest1735) (or (null? first1736) (if (null? rest1735) (letrec ((andmap1738 (lambda (first1739) (let ((x1740 (car first1739)) (first1741 (cdr first1739))) (if (null? first1741) (f1737 x1740) (and (f1737 x1740) (andmap1738 first1741))))))) (andmap1738 first1736)) (letrec ((andmap1742 (lambda (first1743 rest1744) (let ((x1745 (car first1743)) (xr1746 (map car rest1744)) (first1747 (cdr first1743)) (rest1748 (map cdr rest1744))) (if (null? first1747) (apply f1737 (cons x1745 xr1746)) (and (apply f1737 (cons x1745 xr1746)) (andmap1742 first1747 rest1748))))))) (andmap1742 first1736 rest1735))))))) (letrec ((lambda-var-list1840 (lambda (vars1969) (letrec ((lvl1970 (lambda (vars1971 ls1972 w1973) (cond ((pair? vars1971) (lvl1970 (cdr vars1971) (cons (wrap1819 (car vars1971) w1973 (quote #f)) ls1972) w1973)) ((id?1791 vars1971) (cons (wrap1819 vars1971 w1973 (quote #f)) ls1972)) ((null? vars1971) ls1972) ((syntax-object?1775 vars1971) (lvl1970 (syntax-object-expression1776 vars1971) ls1972 (join-wraps1810 w1973 (syntax-object-wrap1777 vars1971)))) ((annotation? vars1971) (lvl1970 (annotation-expression vars1971) ls1972 w1973)) (else (cons vars1971 ls1972)))))) (lvl1970 vars1969 (quote ()) (quote (())))))) (gen-var1839 (lambda (id1974) (let ((id1975 (if (syntax-object?1775 id1974) (syntax-object-expression1776 id1974) id1974))) (if (annotation? id1975) (gensym (symbol->string (annotation-expression id1975))) (gensym (symbol->string id1975)))))) (strip1838 (lambda (x1976 w1977) (if (memq (quote top) (wrap-marks1794 w1977)) (if (or (annotation? x1976) (and (pair? x1976) (annotation? (car x1976)))) (strip-annotation1837 x1976 (quote #f)) x1976) (letrec ((f1978 (lambda (x1979) (cond ((syntax-object?1775 x1979) (strip1838 (syntax-object-expression1776 x1979) (syntax-object-wrap1777 x1979))) ((pair? x1979) (let ((a1980 (f1978 (car x1979))) (d1981 (f1978 (cdr x1979)))) (if (and (eq? a1980 (car x1979)) (eq? d1981 (cdr x1979))) x1979 (cons a1980 d1981)))) ((vector? x1979) (let ((old1982 (vector->list x1979))) (let ((new1983 (map f1978 old1982))) (if (and-map*1697 eq? old1982 new1983) x1979 (list->vector new1983))))) (else x1979))))) (f1978 x1976))))) (strip-annotation1837 (lambda (x1984 parent1985) (cond ((pair? x1984) (let ((new1986 (cons (quote #f) (quote #f)))) (begin (if parent1985 (set-annotation-stripped! parent1985 new1986)) (set-car! new1986 (strip-annotation1837 (car x1984) (quote #f))) (set-cdr! new1986 (strip-annotation1837 (cdr x1984) (quote #f))) new1986))) ((annotation? x1984) (or (annotation-stripped x1984) (strip-annotation1837 (annotation-expression x1984) x1984))) ((vector? x1984) (let ((new1987 (make-vector (vector-length x1984)))) (begin (if parent1985 (set-annotation-stripped! parent1985 new1987)) (letrec ((loop1988 (lambda (i1989) (unless (fx<1754 i1989 (quote 0)) (vector-set! new1987 i1989 (strip-annotation1837 (vector-ref x1984 i1989) (quote #f))) (loop1988 (fx-1752 i1989 (quote 1))))))) (loop1988 (- (vector-length x1984) (quote 1)))) new1987))) (else x1984)))) (ellipsis?1836 (lambda (x1990) (and (nonsymbol-id?1790 x1990) (free-id=?1814 x1990 (quote #(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))))))) (chi-void1835 (lambda () (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote if)) (quote (#f #f))))) (eval-local-transformer1834 (lambda (expanded1991 mod1992) (let ((p1993 (local-eval-hook1756 expanded1991 mod1992))) (if (procedure? p1993) p1993 (syntax-violation (quote #f) (quote "nonprocedure transformer") p1993))))) (chi-local-syntax1833 (lambda (rec?1994 e1995 r1996 w1997 s1998 mod1999 k2000) ((lambda (tmp2001) ((lambda (tmp2002) (if tmp2002 (apply (lambda (_2003 id2004 val2005 e12006 e22007) (let ((ids2008 id2004)) (if (not (valid-bound-ids?1816 ids2008)) (syntax-violation (quote #f) (quote "duplicate bound keyword") e1995) (let ((labels2010 (gen-labels1797 ids2008))) (let ((new-w2011 (make-binding-wrap1808 ids2008 labels2010 w1997))) (k2000 (cons e12006 e22007) (extend-env1785 labels2010 (let ((w2013 (if rec?1994 new-w2011 w1997)) (trans-r2014 (macros-only-env1787 r1996))) (map (lambda (x2015) (cons (quote macro) (eval-local-transformer1834 (chi1827 x2015 trans-r2014 w2013 mod1999) mod1999))) val2005)) r1996) new-w2011 s1998 mod1999)))))) tmp2002) ((lambda (_2017) (syntax-violation (quote #f) (quote "bad local syntax definition") (source-wrap1820 e1995 w1997 s1998 mod1999))) tmp2001))) ($sc-dispatch tmp2001 (quote (any #(each (any any)) any . each-any))))) e1995))) (chi-lambda-clause1832 (lambda (e2018 docstring2019 c2020 r2021 w2022 mod2023 k2024) ((lambda (tmp2025) ((lambda (tmp2026) (if (if tmp2026 (apply (lambda (args2027 doc2028 e12029 e22030) (and (string? (syntax->datum doc2028)) (not docstring2019))) tmp2026) (quote #f)) (apply (lambda (args2031 doc2032 e12033 e22034) (chi-lambda-clause1832 e2018 doc2032 (cons args2031 (cons e12033 e22034)) r2021 w2022 mod2023 k2024)) tmp2026) ((lambda (tmp2036) (if tmp2036 (apply (lambda (id2037 e12038 e22039) (let ((ids2040 id2037)) (if (not (valid-bound-ids?1816 ids2040)) (syntax-violation (quote lambda) (quote "invalid parameter list") e2018) (let ((labels2042 (gen-labels1797 ids2040)) (new-vars2043 (map gen-var1839 ids2040))) (k2024 new-vars2043 docstring2019 (chi-body1831 (cons e12038 e22039) e2018 (extend-var-env1786 labels2042 new-vars2043 r2021) (make-binding-wrap1808 ids2040 labels2042 w2022) mod2023)))))) tmp2036) ((lambda (tmp2045) (if tmp2045 (apply (lambda (ids2046 e12047 e22048) (let ((old-ids2049 (lambda-var-list1840 ids2046))) (if (not (valid-bound-ids?1816 old-ids2049)) (syntax-violation (quote lambda) (quote "invalid parameter list") e2018) (let ((labels2050 (gen-labels1797 old-ids2049)) (new-vars2051 (map gen-var1839 old-ids2049))) (k2024 (letrec ((f2052 (lambda (ls12053 ls22054) (if (null? ls12053) ls22054 (f2052 (cdr ls12053) (cons (car ls12053) ls22054)))))) (f2052 (cdr new-vars2051) (car new-vars2051))) docstring2019 (chi-body1831 (cons e12047 e22048) e2018 (extend-var-env1786 labels2050 new-vars2051 r2021) (make-binding-wrap1808 old-ids2049 labels2050 w2022) mod2023)))))) tmp2045) ((lambda (_2056) (syntax-violation (quote lambda) (quote "bad lambda") e2018)) tmp2025))) ($sc-dispatch tmp2025 (quote (any any . each-any)))))) ($sc-dispatch tmp2025 (quote (each-any any . each-any)))))) ($sc-dispatch tmp2025 (quote (any any any . each-any))))) c2020))) (chi-body1831 (lambda (body2057 outer-form2058 r2059 w2060 mod2061) (let ((r2062 (cons (quote ("placeholder" placeholder)) r2059))) (let ((ribcage2063 (make-ribcage1798 (quote ()) (quote ()) (quote ())))) (let ((w2064 (make-wrap1793 (wrap-marks1794 w2060) (cons ribcage2063 (wrap-subst1795 w2060))))) (letrec ((parse2065 (lambda (body2066 ids2067 labels2068 vars2069 vals2070 bindings2071) (if (null? body2066) (syntax-violation (quote #f) (quote "no expressions in body") outer-form2058) (let ((e2073 (cdar body2066)) (er2074 (caar body2066))) (call-with-values (lambda () (syntax-type1825 e2073 er2074 (quote (())) (quote #f) ribcage2063 mod2061)) (lambda (type2075 value2076 e2077 w2078 s2079 mod2080) (let ((t2081 type2075)) (if (memv t2081 (quote (define-form))) (let ((id2082 (wrap1819 value2076 w2078 mod2080)) (label2083 (gen-label1796))) (let ((var2084 (gen-var1839 id2082))) (begin (extend-ribcage!1807 ribcage2063 id2082 label2083) (parse2065 (cdr body2066) (cons id2082 ids2067) (cons label2083 labels2068) (cons var2084 vars2069) (cons (cons er2074 (wrap1819 e2077 w2078 mod2080)) vals2070) (cons (cons (quote lexical) var2084) bindings2071))))) (if (memv t2081 (quote (define-syntax-form))) (let ((id2085 (wrap1819 value2076 w2078 mod2080)) (label2086 (gen-label1796))) (begin (extend-ribcage!1807 ribcage2063 id2085 label2086) (parse2065 (cdr body2066) (cons id2085 ids2067) (cons label2086 labels2068) vars2069 vals2070 (cons (cons (quote macro) (cons er2074 (wrap1819 e2077 w2078 mod2080))) bindings2071)))) (if (memv t2081 (quote (begin-form))) ((lambda (tmp2087) ((lambda (tmp2088) (if tmp2088 (apply (lambda (_2089 e12090) (parse2065 (letrec ((f2091 (lambda (forms2092) (if (null? forms2092) (cdr body2066) (cons (cons er2074 (wrap1819 (car forms2092) w2078 mod2080)) (f2091 (cdr forms2092))))))) (f2091 e12090)) ids2067 labels2068 vars2069 vals2070 bindings2071)) tmp2088) (syntax-violation #f "source expression failed to match any pattern" tmp2087))) ($sc-dispatch tmp2087 (quote (any . each-any))))) e2077) (if (memv t2081 (quote (local-syntax-form))) (chi-local-syntax1833 value2076 e2077 er2074 w2078 s2079 mod2080 (lambda (forms2094 er2095 w2096 s2097 mod2098) (parse2065 (letrec ((f2099 (lambda (forms2100) (if (null? forms2100) (cdr body2066) (cons (cons er2095 (wrap1819 (car forms2100) w2096 mod2098)) (f2099 (cdr forms2100))))))) (f2099 forms2094)) ids2067 labels2068 vars2069 vals2070 bindings2071))) (if (null? ids2067) (build-sequence1770 (quote #f) (map (lambda (x2101) (chi1827 (cdr x2101) (car x2101) (quote (())) mod2080)) (cons (cons er2074 (source-wrap1820 e2077 w2078 s2079 mod2080)) (cdr body2066)))) (begin (if (not (valid-bound-ids?1816 ids2067)) (syntax-violation (quote #f) (quote "invalid or duplicate identifier in definition") outer-form2058)) (letrec ((loop2102 (lambda (bs2103 er-cache2104 r-cache2105) (if (not (null? bs2103)) (let ((b2106 (car bs2103))) (if (eq? (car b2106) (quote macro)) (let ((er2107 (cadr b2106))) (let ((r-cache2108 (if (eq? er2107 er-cache2104) r-cache2105 (macros-only-env1787 er2107)))) (begin (set-cdr! b2106 (eval-local-transformer1834 (chi1827 (cddr b2106) r-cache2108 (quote (())) mod2080) mod2080)) (loop2102 (cdr bs2103) er2107 r-cache2108)))) (loop2102 (cdr bs2103) er-cache2104 r-cache2105))))))) (loop2102 bindings2071 (quote #f) (quote #f))) (set-cdr! r2062 (extend-env1785 labels2068 bindings2071 (cdr r2062))) (build-letrec1773 (quote #f) vars2069 (map (lambda (x2109) (chi1827 (cdr x2109) (car x2109) (quote (())) mod2080)) vals2070) (build-sequence1770 (quote #f) (map (lambda (x2110) (chi1827 (cdr x2110) (car x2110) (quote (())) mod2080)) (cons (cons er2074 (source-wrap1820 e2077 w2078 s2079 mod2080)) (cdr body2066))))))))))))))))))) (parse2065 (map (lambda (x2072) (cons r2062 (wrap1819 x2072 w2064 mod2061))) body2057) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro1830 (lambda (p2111 e2112 r2113 w2114 rib2115 mod2116) (letrec ((rebuild-macro-output2117 (lambda (x2118 m2119) (cond ((pair? x2118) (cons (rebuild-macro-output2117 (car x2118) m2119) (rebuild-macro-output2117 (cdr x2118) m2119))) ((syntax-object?1775 x2118) (let ((w2120 (syntax-object-wrap1777 x2118))) (let ((ms2121 (wrap-marks1794 w2120)) (s2122 (wrap-subst1795 w2120))) (if (and (pair? ms2121) (eq? (car ms2121) (quote #f))) (make-syntax-object1774 (syntax-object-expression1776 x2118) (make-wrap1793 (cdr ms2121) (if rib2115 (cons rib2115 (cdr s2122)) (cdr s2122))) (syntax-object-module1778 x2118)) (make-syntax-object1774 (syntax-object-expression1776 x2118) (make-wrap1793 (cons m2119 ms2121) (if rib2115 (cons rib2115 (cons (quote shift) s2122)) (cons (quote shift) s2122))) (let ((pmod2123 (procedure-module p2111))) (if pmod2123 (cons (quote hygiene) (module-name pmod2123)) (quote (hygiene guile))))))))) ((vector? x2118) (let ((n2124 (vector-length x2118))) (let ((v2125 (make-vector n2124))) (letrec ((doloop2126 (lambda (i2127) (if (fx=1753 i2127 n2124) v2125 (begin (vector-set! v2125 i2127 (rebuild-macro-output2117 (vector-ref x2118 i2127) m2119)) (doloop2126 (fx+1751 i2127 (quote 1)))))))) (doloop2126 (quote 0)))))) ((symbol? x2118) (syntax-violation (quote #f) (quote "encountered raw symbol in macro output") (source-wrap1820 e2112 w2114 s mod2116) x2118)) (else x2118))))) (rebuild-macro-output2117 (p2111 (wrap1819 e2112 (anti-mark1806 w2114) mod2116)) (string (quote #\m)))))) (chi-application1829 (lambda (x2128 e2129 r2130 w2131 s2132 mod2133) ((lambda (tmp2134) ((lambda (tmp2135) (if tmp2135 (apply (lambda (e02136 e12137) (build-application1759 s2132 x2128 (map (lambda (e2138) (chi1827 e2138 r2130 w2131 mod2133)) e12137))) tmp2135) (syntax-violation #f "source expression failed to match any pattern" tmp2134))) ($sc-dispatch tmp2134 (quote (any . each-any))))) e2129))) (chi-expr1828 (lambda (type2140 value2141 e2142 r2143 w2144 s2145 mod2146) (let ((t2147 type2140)) (if (memv t2147 (quote (lexical))) (build-lexical-reference1761 (quote value) s2145 e2142 value2141) (if (memv t2147 (quote (core external-macro))) (value2141 e2142 r2143 w2144 s2145 mod2146) (if (memv t2147 (quote (module-ref))) (call-with-values (lambda () (value2141 e2142)) (lambda (id2148 mod2149) (build-global-reference1764 s2145 id2148 mod2149))) (if (memv t2147 (quote (lexical-call))) (chi-application1829 (build-lexical-reference1761 (quote fun) (source-annotation1782 (car e2142)) (car e2142) value2141) e2142 r2143 w2144 s2145 mod2146) (if (memv t2147 (quote (global-call))) (chi-application1829 (build-global-reference1764 (source-annotation1782 (car e2142)) value2141 (if (syntax-object?1775 (car e2142)) (syntax-object-module1778 (car e2142)) mod2146)) e2142 r2143 w2144 s2145 mod2146) (if (memv t2147 (quote (constant))) (build-data1769 s2145 (strip1838 (source-wrap1820 e2142 w2144 s2145 mod2146) (quote (())))) (if (memv t2147 (quote (global))) (build-global-reference1764 s2145 value2141 mod2146) (if (memv t2147 (quote (call))) (chi-application1829 (chi1827 (car e2142) r2143 w2144 mod2146) e2142 r2143 w2144 s2145 mod2146) (if (memv t2147 (quote (begin-form))) ((lambda (tmp2150) ((lambda (tmp2151) (if tmp2151 (apply (lambda (_2152 e12153 e22154) (chi-sequence1821 (cons e12153 e22154) r2143 w2144 s2145 mod2146)) tmp2151) (syntax-violation #f "source expression failed to match any pattern" tmp2150))) ($sc-dispatch tmp2150 (quote (any any . each-any))))) e2142) (if (memv t2147 (quote (local-syntax-form))) (chi-local-syntax1833 value2141 e2142 r2143 w2144 s2145 mod2146 chi-sequence1821) (if (memv t2147 (quote (eval-when-form))) ((lambda (tmp2156) ((lambda (tmp2157) (if tmp2157 (apply (lambda (_2158 x2159 e12160 e22161) (let ((when-list2162 (chi-when-list1824 e2142 x2159 w2144))) (if (memq (quote eval) when-list2162) (chi-sequence1821 (cons e12160 e22161) r2143 w2144 s2145 mod2146) (chi-void1835)))) tmp2157) (syntax-violation #f "source expression failed to match any pattern" tmp2156))) ($sc-dispatch tmp2156 (quote (any each-any any . each-any))))) e2142) (if (memv t2147 (quote (define-form define-syntax-form))) (syntax-violation (quote #f) (quote "definition in expression context") e2142 (wrap1819 value2141 w2144 mod2146)) (if (memv t2147 (quote (syntax))) (syntax-violation (quote #f) (quote "reference to pattern variable outside syntax form") (source-wrap1820 e2142 w2144 s2145 mod2146)) (if (memv t2147 (quote (displaced-lexical))) (syntax-violation (quote #f) (quote "reference to identifier outside its scope") (source-wrap1820 e2142 w2144 s2145 mod2146)) (syntax-violation (quote #f) (quote "unexpected syntax") (source-wrap1820 e2142 w2144 s2145 mod2146))))))))))))))))))) (chi1827 (lambda (e2165 r2166 w2167 mod2168) (call-with-values (lambda () (syntax-type1825 e2165 r2166 w2167 (quote #f) (quote #f) mod2168)) (lambda (type2169 value2170 e2171 w2172 s2173 mod2174) (chi-expr1828 type2169 value2170 e2171 r2166 w2172 s2173 mod2174))))) (chi-top1826 (lambda (e2175 r2176 w2177 m2178 esew2179 mod2180) (call-with-values (lambda () (syntax-type1825 e2175 r2176 w2177 (quote #f) (quote #f) mod2180)) (lambda (type2188 value2189 e2190 w2191 s2192 mod2193) (let ((t2194 type2188)) (if (memv t2194 (quote (begin-form))) ((lambda (tmp2195) ((lambda (tmp2196) (if tmp2196 (apply (lambda (_2197) (chi-void1835)) tmp2196) ((lambda (tmp2198) (if tmp2198 (apply (lambda (_2199 e12200 e22201) (chi-top-sequence1822 (cons e12200 e22201) r2176 w2191 s2192 m2178 esew2179 mod2193)) tmp2198) (syntax-violation #f "source expression failed to match any pattern" tmp2195))) ($sc-dispatch tmp2195 (quote (any any . each-any)))))) ($sc-dispatch tmp2195 (quote (any))))) e2190) (if (memv t2194 (quote (local-syntax-form))) (chi-local-syntax1833 value2189 e2190 r2176 w2191 s2192 mod2193 (lambda (body2203 r2204 w2205 s2206 mod2207) (chi-top-sequence1822 body2203 r2204 w2205 s2206 m2178 esew2179 mod2207))) (if (memv t2194 (quote (eval-when-form))) ((lambda (tmp2208) ((lambda (tmp2209) (if tmp2209 (apply (lambda (_2210 x2211 e12212 e22213) (let ((when-list2214 (chi-when-list1824 e2190 x2211 w2191)) (body2215 (cons e12212 e22213))) (cond ((eq? m2178 (quote e)) (if (memq (quote eval) when-list2214) (chi-top-sequence1822 body2215 r2176 w2191 s2192 (quote e) (quote (eval)) mod2193) (chi-void1835))) ((memq (quote load) when-list2214) (if (or (memq (quote compile) when-list2214) (and (eq? m2178 (quote c&e)) (memq (quote eval) when-list2214))) (chi-top-sequence1822 body2215 r2176 w2191 s2192 (quote c&e) (quote (compile load)) mod2193) (if (memq m2178 (quote (c c&e))) (chi-top-sequence1822 body2215 r2176 w2191 s2192 (quote c) (quote (load)) mod2193) (chi-void1835)))) ((or (memq (quote compile) when-list2214) (and (eq? m2178 (quote c&e)) (memq (quote eval) when-list2214))) (top-level-eval-hook1755 (chi-top-sequence1822 body2215 r2176 w2191 s2192 (quote e) (quote (eval)) mod2193) mod2193) (chi-void1835)) (else (chi-void1835))))) tmp2209) (syntax-violation #f "source expression failed to match any pattern" tmp2208))) ($sc-dispatch tmp2208 (quote (any each-any any . each-any))))) e2190) (if (memv t2194 (quote (define-syntax-form))) (let ((n2218 (id-var-name1813 value2189 w2191)) (r2219 (macros-only-env1787 r2176))) (let ((t2220 m2178)) (if (memv t2220 (quote (c))) (if (memq (quote compile) esew2179) (let ((e2221 (chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193)))) (begin (top-level-eval-hook1755 e2221 mod2193) (if (memq (quote load) esew2179) e2221 (chi-void1835)))) (if (memq (quote load) esew2179) (chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193)) (chi-void1835))) (if (memv t2220 (quote (c&e))) (let ((e2222 (chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193)))) (begin (top-level-eval-hook1755 e2222 mod2193) e2222)) (begin (if (memq (quote eval) esew2179) (top-level-eval-hook1755 (chi-install-global1823 n2218 (chi1827 e2190 r2219 w2191 mod2193)) mod2193)) (chi-void1835)))))) (if (memv t2194 (quote (define-form))) (let ((n2223 (id-var-name1813 value2189 w2191))) (let ((type2224 (binding-type1783 (lookup1788 n2223 r2176 mod2193)))) (let ((t2225 type2224)) (if (memv t2225 (quote (global core macro module-ref))) (let ((x2226 (build-global-definition1766 s2192 n2223 (chi1827 e2190 r2176 w2191 mod2193)))) (begin (if (eq? m2178 (quote c&e)) (top-level-eval-hook1755 x2226 mod2193)) x2226)) (if (memv t2225 (quote (displaced-lexical))) (syntax-violation (quote #f) (quote "identifier out of context") e2190 (wrap1819 value2189 w2191 mod2193)) (syntax-violation (quote #f) (quote "cannot define keyword at top level") e2190 (wrap1819 value2189 w2191 mod2193))))))) (let ((x2227 (chi-expr1828 type2188 value2189 e2190 r2176 w2191 s2192 mod2193))) (begin (if (eq? m2178 (quote c&e)) (top-level-eval-hook1755 x2227 mod2193)) x2227)))))))))))) (syntax-type1825 (lambda (e2228 r2229 w2230 s2231 rib2232 mod2233) (cond ((symbol? e2228) (let ((n2234 (id-var-name1813 e2228 w2230))) (let ((b2235 (lookup1788 n2234 r2229 mod2233))) (let ((type2236 (binding-type1783 b2235))) (let ((t2237 type2236)) (if (memv t2237 (quote (lexical))) (values type2236 (binding-value1784 b2235) e2228 w2230 s2231 mod2233) (if (memv t2237 (quote (global))) (values type2236 n2234 e2228 w2230 s2231 mod2233) (if (memv t2237 (quote (macro))) (syntax-type1825 (chi-macro1830 (binding-value1784 b2235) e2228 r2229 w2230 rib2232 mod2233) r2229 (quote (())) s2231 rib2232 mod2233) (values type2236 (binding-value1784 b2235) e2228 w2230 s2231 mod2233))))))))) ((pair? e2228) (let ((first2238 (car e2228))) (if (id?1791 first2238) (let ((n2239 (id-var-name1813 first2238 w2230))) (let ((b2240 (lookup1788 n2239 r2229 (or (and (syntax-object?1775 first2238) (syntax-object-module1778 first2238)) mod2233)))) (let ((type2241 (binding-type1783 b2240))) (let ((t2242 type2241)) (if (memv t2242 (quote (lexical))) (values (quote lexical-call) (binding-value1784 b2240) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (global))) (values (quote global-call) n2239 e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (macro))) (syntax-type1825 (chi-macro1830 (binding-value1784 b2240) e2228 r2229 w2230 rib2232 mod2233) r2229 (quote (())) s2231 rib2232 mod2233) (if (memv t2242 (quote (core external-macro module-ref))) (values type2241 (binding-value1784 b2240) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value1784 b2240) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (begin))) (values (quote begin-form) (quote #f) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (eval-when))) (values (quote eval-when-form) (quote #f) e2228 w2230 s2231 mod2233) (if (memv t2242 (quote (define))) ((lambda (tmp2243) ((lambda (tmp2244) (if (if tmp2244 (apply (lambda (_2245 name2246 val2247) (id?1791 name2246)) tmp2244) (quote #f)) (apply (lambda (_2248 name2249 val2250) (values (quote define-form) name2249 val2250 w2230 s2231 mod2233)) tmp2244) ((lambda (tmp2251) (if (if tmp2251 (apply (lambda (_2252 name2253 args2254 e12255 e22256) (and (id?1791 name2253) (valid-bound-ids?1816 (lambda-var-list1840 args2254)))) tmp2251) (quote #f)) (apply (lambda (_2257 name2258 args2259 e12260 e22261) (values (quote define-form) (wrap1819 name2258 w2230 mod2233) (cons (quote #(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) (wrap1819 (cons args2259 (cons e12260 e22261)) w2230 mod2233)) (quote (())) s2231 mod2233)) tmp2251) ((lambda (tmp2263) (if (if tmp2263 (apply (lambda (_2264 name2265) (id?1791 name2265)) tmp2263) (quote #f)) (apply (lambda (_2266 name2267) (values (quote define-form) (wrap1819 name2267 w2230 mod2233) (quote (#(syntax-object if ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)) #(syntax-object #f ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(first) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(e r w s rib mod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote (())) s2231 mod2233)) tmp2263) (syntax-violation #f "source expression failed to match any pattern" tmp2243))) ($sc-dispatch tmp2243 (quote (any any)))))) ($sc-dispatch tmp2243 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp2243 (quote (any any any))))) e2228) (if (memv t2242 (quote (define-syntax))) ((lambda (tmp2268) ((lambda (tmp2269) (if (if tmp2269 (apply (lambda (_2270 name2271 val2272) (id?1791 name2271)) tmp2269) (quote #f)) (apply (lambda (_2273 name2274 val2275) (values (quote define-syntax-form) name2274 val2275 w2230 s2231 mod2233)) tmp2269) (syntax-violation #f "source expression failed to match any pattern" tmp2268))) ($sc-dispatch tmp2268 (quote (any any any))))) e2228) (values (quote call) (quote #f) e2228 w2230 s2231 mod2233)))))))))))))) (values (quote call) (quote #f) e2228 w2230 s2231 mod2233)))) ((syntax-object?1775 e2228) (syntax-type1825 (syntax-object-expression1776 e2228) r2229 (join-wraps1810 w2230 (syntax-object-wrap1777 e2228)) (quote #f) rib2232 (or (syntax-object-module1778 e2228) mod2233))) ((annotation? e2228) (syntax-type1825 (annotation-expression e2228) r2229 w2230 (annotation-source e2228) rib2232 mod2233)) ((self-evaluating? e2228) (values (quote constant) (quote #f) e2228 w2230 s2231 mod2233)) (else (values (quote other) (quote #f) e2228 w2230 s2231 mod2233))))) (chi-when-list1824 (lambda (e2276 when-list2277 w2278) (letrec ((f2279 (lambda (when-list2280 situations2281) (if (null? when-list2280) situations2281 (f2279 (cdr when-list2280) (cons (let ((x2282 (car when-list2280))) (cond ((free-id=?1814 x2282 (quote #(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote compile)) ((free-id=?1814 x2282 (quote #(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote load)) ((free-id=?1814 x2282 (quote #(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f when-list situations) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e when-list w) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile)))) (quote eval)) (else (syntax-violation (quote eval-when) (quote "invalid situation") e2276 (wrap1819 x2282 w2278 (quote #f)))))) situations2281)))))) (f2279 when-list2277 (quote ()))))) (chi-install-global1823 (lambda (name2283 e2284) (build-global-definition1766 (quote #f) name2283 (if (let ((v2285 (module-variable (current-module) name2283))) (and v2285 (variable-bound? v2285) (macro? (variable-ref v2285)) (not (eq? (macro-type (variable-ref v2285)) (quote syncase-macro))))) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote make-extended-syncase-macro)) (list (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote module-ref)) (list (build-application1759 (quote #f) (quote current-module) (quote ())) (build-data1769 (quote #f) name2283))) (build-data1769 (quote #f) (quote macro)) e2284)) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote make-syncase-macro)) (list (build-data1769 (quote #f) (quote macro)) e2284)))))) (chi-top-sequence1822 (lambda (body2286 r2287 w2288 s2289 m2290 esew2291 mod2292) (build-sequence1770 s2289 (letrec ((dobody2293 (lambda (body2294 r2295 w2296 m2297 esew2298 mod2299) (if (null? body2294) (quote ()) (let ((first2300 (chi-top1826 (car body2294) r2295 w2296 m2297 esew2298 mod2299))) (cons first2300 (dobody2293 (cdr body2294) r2295 w2296 m2297 esew2298 mod2299))))))) (dobody2293 body2286 r2287 w2288 m2290 esew2291 mod2292))))) (chi-sequence1821 (lambda (body2301 r2302 w2303 s2304 mod2305) (build-sequence1770 s2304 (letrec ((dobody2306 (lambda (body2307 r2308 w2309 mod2310) (if (null? body2307) (quote ()) (let ((first2311 (chi1827 (car body2307) r2308 w2309 mod2310))) (cons first2311 (dobody2306 (cdr body2307) r2308 w2309 mod2310))))))) (dobody2306 body2301 r2302 w2303 mod2305))))) (source-wrap1820 (lambda (x2312 w2313 s2314 defmod2315) (wrap1819 (if s2314 (make-annotation x2312 s2314 (quote #f)) x2312) w2313 defmod2315))) (wrap1819 (lambda (x2316 w2317 defmod2318) (cond ((and (null? (wrap-marks1794 w2317)) (null? (wrap-subst1795 w2317))) x2316) ((syntax-object?1775 x2316) (make-syntax-object1774 (syntax-object-expression1776 x2316) (join-wraps1810 w2317 (syntax-object-wrap1777 x2316)) (syntax-object-module1778 x2316))) ((null? x2316) x2316) (else (make-syntax-object1774 x2316 w2317 defmod2318))))) (bound-id-member?1818 (lambda (x2319 list2320) (and (not (null? list2320)) (or (bound-id=?1815 x2319 (car list2320)) (bound-id-member?1818 x2319 (cdr list2320)))))) (distinct-bound-ids?1817 (lambda (ids2321) (letrec ((distinct?2322 (lambda (ids2323) (or (null? ids2323) (and (not (bound-id-member?1818 (car ids2323) (cdr ids2323))) (distinct?2322 (cdr ids2323))))))) (distinct?2322 ids2321)))) (valid-bound-ids?1816 (lambda (ids2324) (and (letrec ((all-ids?2325 (lambda (ids2326) (or (null? ids2326) (and (id?1791 (car ids2326)) (all-ids?2325 (cdr ids2326))))))) (all-ids?2325 ids2324)) (distinct-bound-ids?1817 ids2324)))) (bound-id=?1815 (lambda (i2327 j2328) (if (and (syntax-object?1775 i2327) (syntax-object?1775 j2328)) (and (eq? (let ((e2329 (syntax-object-expression1776 i2327))) (if (annotation? e2329) (annotation-expression e2329) e2329)) (let ((e2330 (syntax-object-expression1776 j2328))) (if (annotation? e2330) (annotation-expression e2330) e2330))) (same-marks?1812 (wrap-marks1794 (syntax-object-wrap1777 i2327)) (wrap-marks1794 (syntax-object-wrap1777 j2328)))) (eq? (let ((e2331 i2327)) (if (annotation? e2331) (annotation-expression e2331) e2331)) (let ((e2332 j2328)) (if (annotation? e2332) (annotation-expression e2332) e2332)))))) (free-id=?1814 (lambda (i2333 j2334) (and (eq? (let ((x2335 i2333)) (let ((e2336 (if (syntax-object?1775 x2335) (syntax-object-expression1776 x2335) x2335))) (if (annotation? e2336) (annotation-expression e2336) e2336))) (let ((x2337 j2334)) (let ((e2338 (if (syntax-object?1775 x2337) (syntax-object-expression1776 x2337) x2337))) (if (annotation? e2338) (annotation-expression e2338) e2338)))) (eq? (id-var-name1813 i2333 (quote (()))) (id-var-name1813 j2334 (quote (()))))))) (id-var-name1813 (lambda (id2339 w2340) (letrec ((search-vector-rib2343 (lambda (sym2349 subst2350 marks2351 symnames2352 ribcage2353) (let ((n2354 (vector-length symnames2352))) (letrec ((f2355 (lambda (i2356) (cond ((fx=1753 i2356 n2354) (search2341 sym2349 (cdr subst2350) marks2351)) ((and (eq? (vector-ref symnames2352 i2356) sym2349) (same-marks?1812 marks2351 (vector-ref (ribcage-marks1801 ribcage2353) i2356))) (values (vector-ref (ribcage-labels1802 ribcage2353) i2356) marks2351)) (else (f2355 (fx+1751 i2356 (quote 1)))))))) (f2355 (quote 0)))))) (search-list-rib2342 (lambda (sym2357 subst2358 marks2359 symnames2360 ribcage2361) (letrec ((f2362 (lambda (symnames2363 i2364) (cond ((null? symnames2363) (search2341 sym2357 (cdr subst2358) marks2359)) ((and (eq? (car symnames2363) sym2357) (same-marks?1812 marks2359 (list-ref (ribcage-marks1801 ribcage2361) i2364))) (values (list-ref (ribcage-labels1802 ribcage2361) i2364) marks2359)) (else (f2362 (cdr symnames2363) (fx+1751 i2364 (quote 1)))))))) (f2362 symnames2360 (quote 0))))) (search2341 (lambda (sym2365 subst2366 marks2367) (if (null? subst2366) (values (quote #f) marks2367) (let ((fst2368 (car subst2366))) (if (eq? fst2368 (quote shift)) (search2341 sym2365 (cdr subst2366) (cdr marks2367)) (let ((symnames2369 (ribcage-symnames1800 fst2368))) (if (vector? symnames2369) (search-vector-rib2343 sym2365 subst2366 marks2367 symnames2369 fst2368) (search-list-rib2342 sym2365 subst2366 marks2367 symnames2369 fst2368))))))))) (cond ((symbol? id2339) (or (call-with-values (lambda () (search2341 id2339 (wrap-subst1795 w2340) (wrap-marks1794 w2340))) (lambda (x2371 . ignore2370) x2371)) id2339)) ((syntax-object?1775 id2339) (let ((id2372 (let ((e2374 (syntax-object-expression1776 id2339))) (if (annotation? e2374) (annotation-expression e2374) e2374))) (w12373 (syntax-object-wrap1777 id2339))) (let ((marks2375 (join-marks1811 (wrap-marks1794 w2340) (wrap-marks1794 w12373)))) (call-with-values (lambda () (search2341 id2372 (wrap-subst1795 w2340) marks2375)) (lambda (new-id2376 marks2377) (or new-id2376 (call-with-values (lambda () (search2341 id2372 (wrap-subst1795 w12373) marks2377)) (lambda (x2379 . ignore2378) x2379)) id2372)))))) ((annotation? id2339) (let ((id2380 (let ((e2381 id2339)) (if (annotation? e2381) (annotation-expression e2381) e2381)))) (or (call-with-values (lambda () (search2341 id2380 (wrap-subst1795 w2340) (wrap-marks1794 w2340))) (lambda (x2383 . ignore2382) x2383)) id2380))) (else (syntax-violation (quote id-var-name) (quote "invalid id") id2339)))))) (same-marks?1812 (lambda (x2384 y2385) (or (eq? x2384 y2385) (and (not (null? x2384)) (not (null? y2385)) (eq? (car x2384) (car y2385)) (same-marks?1812 (cdr x2384) (cdr y2385)))))) (join-marks1811 (lambda (m12386 m22387) (smart-append1809 m12386 m22387))) (join-wraps1810 (lambda (w12388 w22389) (let ((m12390 (wrap-marks1794 w12388)) (s12391 (wrap-subst1795 w12388))) (if (null? m12390) (if (null? s12391) w22389 (make-wrap1793 (wrap-marks1794 w22389) (smart-append1809 s12391 (wrap-subst1795 w22389)))) (make-wrap1793 (smart-append1809 m12390 (wrap-marks1794 w22389)) (smart-append1809 s12391 (wrap-subst1795 w22389))))))) (smart-append1809 (lambda (m12392 m22393) (if (null? m22393) m12392 (append m12392 m22393)))) (make-binding-wrap1808 (lambda (ids2394 labels2395 w2396) (if (null? ids2394) w2396 (make-wrap1793 (wrap-marks1794 w2396) (cons (let ((labelvec2397 (list->vector labels2395))) (let ((n2398 (vector-length labelvec2397))) (let ((symnamevec2399 (make-vector n2398)) (marksvec2400 (make-vector n2398))) (begin (letrec ((f2401 (lambda (ids2402 i2403) (if (not (null? ids2402)) (call-with-values (lambda () (id-sym-name&marks1792 (car ids2402) w2396)) (lambda (symname2404 marks2405) (begin (vector-set! symnamevec2399 i2403 symname2404) (vector-set! marksvec2400 i2403 marks2405) (f2401 (cdr ids2402) (fx+1751 i2403 (quote 1)))))))))) (f2401 ids2394 (quote 0))) (make-ribcage1798 symnamevec2399 marksvec2400 labelvec2397))))) (wrap-subst1795 w2396)))))) (extend-ribcage!1807 (lambda (ribcage2406 id2407 label2408) (begin (set-ribcage-symnames!1803 ribcage2406 (cons (let ((e2409 (syntax-object-expression1776 id2407))) (if (annotation? e2409) (annotation-expression e2409) e2409)) (ribcage-symnames1800 ribcage2406))) (set-ribcage-marks!1804 ribcage2406 (cons (wrap-marks1794 (syntax-object-wrap1777 id2407)) (ribcage-marks1801 ribcage2406))) (set-ribcage-labels!1805 ribcage2406 (cons label2408 (ribcage-labels1802 ribcage2406)))))) (anti-mark1806 (lambda (w2410) (make-wrap1793 (cons (quote #f) (wrap-marks1794 w2410)) (cons (quote shift) (wrap-subst1795 w2410))))) (set-ribcage-labels!1805 (lambda (x2411 update2412) (vector-set! x2411 (quote 3) update2412))) (set-ribcage-marks!1804 (lambda (x2413 update2414) (vector-set! x2413 (quote 2) update2414))) (set-ribcage-symnames!1803 (lambda (x2415 update2416) (vector-set! x2415 (quote 1) update2416))) (ribcage-labels1802 (lambda (x2417) (vector-ref x2417 (quote 3)))) (ribcage-marks1801 (lambda (x2418) (vector-ref x2418 (quote 2)))) (ribcage-symnames1800 (lambda (x2419) (vector-ref x2419 (quote 1)))) (ribcage?1799 (lambda (x2420) (and (vector? x2420) (= (vector-length x2420) (quote 4)) (eq? (vector-ref x2420 (quote 0)) (quote ribcage))))) (make-ribcage1798 (lambda (symnames2421 marks2422 labels2423) (vector (quote ribcage) symnames2421 marks2422 labels2423))) (gen-labels1797 (lambda (ls2424) (if (null? ls2424) (quote ()) (cons (gen-label1796) (gen-labels1797 (cdr ls2424)))))) (gen-label1796 (lambda () (string (quote #\i)))) (wrap-subst1795 cdr) (wrap-marks1794 car) (make-wrap1793 cons) (id-sym-name&marks1792 (lambda (x2425 w2426) (if (syntax-object?1775 x2425) (values (let ((e2427 (syntax-object-expression1776 x2425))) (if (annotation? e2427) (annotation-expression e2427) e2427)) (join-marks1811 (wrap-marks1794 w2426) (wrap-marks1794 (syntax-object-wrap1777 x2425)))) (values (let ((e2428 x2425)) (if (annotation? e2428) (annotation-expression e2428) e2428)) (wrap-marks1794 w2426))))) (id?1791 (lambda (x2429) (cond ((symbol? x2429) (quote #t)) ((syntax-object?1775 x2429) (symbol? (let ((e2430 (syntax-object-expression1776 x2429))) (if (annotation? e2430) (annotation-expression e2430) e2430)))) ((annotation? x2429) (symbol? (annotation-expression x2429))) (else (quote #f))))) (nonsymbol-id?1790 (lambda (x2431) (and (syntax-object?1775 x2431) (symbol? (let ((e2432 (syntax-object-expression1776 x2431))) (if (annotation? e2432) (annotation-expression e2432) e2432)))))) (global-extend1789 (lambda (type2433 sym2434 val2435) (put-global-definition-hook1757 sym2434 type2433 val2435))) (lookup1788 (lambda (x2436 r2437 mod2438) (cond ((assq x2436 r2437) => cdr) ((symbol? x2436) (or (get-global-definition-hook1758 x2436 mod2438) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env1787 (lambda (r2439) (if (null? r2439) (quote ()) (let ((a2440 (car r2439))) (if (eq? (cadr a2440) (quote macro)) (cons a2440 (macros-only-env1787 (cdr r2439))) (macros-only-env1787 (cdr r2439))))))) (extend-var-env1786 (lambda (labels2441 vars2442 r2443) (if (null? labels2441) r2443 (extend-var-env1786 (cdr labels2441) (cdr vars2442) (cons (cons (car labels2441) (cons (quote lexical) (car vars2442))) r2443))))) (extend-env1785 (lambda (labels2444 bindings2445 r2446) (if (null? labels2444) r2446 (extend-env1785 (cdr labels2444) (cdr bindings2445) (cons (cons (car labels2444) (car bindings2445)) r2446))))) (binding-value1784 cdr) (binding-type1783 car) (source-annotation1782 (lambda (x2447) (cond ((annotation? x2447) (annotation-source x2447)) ((syntax-object?1775 x2447) (source-annotation1782 (syntax-object-expression1776 x2447))) (else (quote #f))))) (set-syntax-object-module!1781 (lambda (x2448 update2449) (vector-set! x2448 (quote 3) update2449))) (set-syntax-object-wrap!1780 (lambda (x2450 update2451) (vector-set! x2450 (quote 2) update2451))) (set-syntax-object-expression!1779 (lambda (x2452 update2453) (vector-set! x2452 (quote 1) update2453))) (syntax-object-module1778 (lambda (x2454) (vector-ref x2454 (quote 3)))) (syntax-object-wrap1777 (lambda (x2455) (vector-ref x2455 (quote 2)))) (syntax-object-expression1776 (lambda (x2456) (vector-ref x2456 (quote 1)))) (syntax-object?1775 (lambda (x2457) (and (vector? x2457) (= (vector-length x2457) (quote 4)) (eq? (vector-ref x2457 (quote 0)) (quote syntax-object))))) (make-syntax-object1774 (lambda (expression2458 wrap2459 module2460) (vector (quote syntax-object) expression2458 wrap2459 module2460))) (build-letrec1773 (lambda (src2461 vars2462 val-exps2463 body-exp2464) (if (null? vars2462) body-exp2464 (let ((t2465 (fluid-ref *mode*1750))) (if (memv t2465 (quote (c))) ((@ (language tree-il) make-letrec) src2461 vars2462 val-exps2463 body-exp2464) (list (quote letrec) (map list vars2462 val-exps2463) body-exp2464)))))) (build-named-let1772 (lambda (src2466 vars2467 val-exps2468 body-exp2469) (let ((f2470 (car vars2467)) (vars2471 (cdr vars2467))) (let ((t2472 (fluid-ref *mode*1750))) (if (memv t2472 (quote (c))) ((@ (language tree-il) make-letrec) src2466 (list f2470) (list (build-lambda1767 src2466 vars2471 (quote #f) body-exp2469)) (build-application1759 src2466 (build-lexical-reference1761 (quote fun) src2466 f2470 f2470) val-exps2468)) (list (quote let) f2470 (map list vars2471 val-exps2468) body-exp2469)))))) (build-let1771 (lambda (src2473 vars2474 val-exps2475 body-exp2476) (if (null? vars2474) body-exp2476 (let ((t2477 (fluid-ref *mode*1750))) (if (memv t2477 (quote (c))) ((@ (language tree-il) make-let) src2473 vars2474 val-exps2475 body-exp2476) (list (quote let) (map list vars2474 val-exps2475) body-exp2476)))))) (build-sequence1770 (lambda (src2478 exps2479) (if (null? (cdr exps2479)) (car exps2479) (let ((t2480 (fluid-ref *mode*1750))) (if (memv t2480 (quote (c))) ((@ (language tree-il) make-sequence) src2478 exps2479) (cons (quote begin) exps2479)))))) (build-data1769 (lambda (src2481 exp2482) (let ((t2483 (fluid-ref *mode*1750))) (if (memv t2483 (quote (c))) ((@ (language tree-il) make-const) src2481 exp2482) (if (and (self-evaluating? exp2482) (not (vector? exp2482))) exp2482 (list (quote quote) exp2482)))))) (build-primref1768 (lambda (src2484 name2485) (let ((t2486 (fluid-ref *mode*1750))) (if (memv t2486 (quote (c))) ((@ (language tree-il) make-primitive-ref) src2484 name2485) (build-global-reference1764 src2484 name2485 (quote (hygiene guile))))))) (build-lambda1767 (lambda (src2487 vars2488 docstring2489 exp2490) (let ((t2491 (fluid-ref *mode*1750))) (if (memv t2491 (quote (c))) ((@ (language tree-il) make-lambda) src2487 vars2488 (if docstring2489 (list (cons (quote documentation) docstring2489)) (quote ())) exp2490) (cons (quote lambda) (cons vars2488 (append (if docstring2489 (list docstring2489) (quote ())) (list exp2490)))))))) (build-global-definition1766 (lambda (source2492 var2493 exp2494) (let ((t2495 (fluid-ref *mode*1750))) (if (memv t2495 (quote (c))) ((@ (language tree-il) make-toplevel-define) source2492 var2493 exp2494) (list (quote define) var2493 exp2494))))) (build-global-assignment1765 (lambda (source2496 var2497 exp2498 mod2499) (analyze-variable1763 mod2499 var2497 (lambda (mod2500 var2501 public?2502) (let ((t2503 (fluid-ref *mode*1750))) (if (memv t2503 (quote (c))) ((@ (language tree-il) make-module-set) source2496 mod2500 var2501 public?2502 exp2498) (list (quote set!) (list (if public?2502 (quote @) (quote @@)) mod2500 var2501) exp2498)))) (lambda (var2504) (let ((t2505 (fluid-ref *mode*1750))) (if (memv t2505 (quote (c))) ((@ (language tree-il) make-toplevel-set) source2496 var2504 exp2498) (list (quote set!) var2504 exp2498))))))) (build-global-reference1764 (lambda (source2506 var2507 mod2508) (analyze-variable1763 mod2508 var2507 (lambda (mod2509 var2510 public?2511) (let ((t2512 (fluid-ref *mode*1750))) (if (memv t2512 (quote (c))) ((@ (language tree-il) make-module-ref) source2506 mod2509 var2510 public?2511) (list (if public?2511 (quote @) (quote @@)) mod2509 var2510)))) (lambda (var2513) (let ((t2514 (fluid-ref *mode*1750))) (if (memv t2514 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source2506 var2513) var2513)))))) (analyze-variable1763 (lambda (mod2515 var2516 modref-cont2517 bare-cont2518) (if (not mod2515) (bare-cont2518 var2516) (let ((kind2519 (car mod2515)) (mod2520 (cdr mod2515))) (let ((t2521 kind2519)) (if (memv t2521 (quote (public))) (modref-cont2517 mod2520 var2516 (quote #t)) (if (memv t2521 (quote (private))) (if (not (equal? mod2520 (module-name (current-module)))) (modref-cont2517 mod2520 var2516 (quote #f)) (bare-cont2518 var2516)) (if (memv t2521 (quote (bare))) (bare-cont2518 var2516) (if (memv t2521 (quote (hygiene))) (if (and (not (equal? mod2520 (module-name (current-module)))) (module-variable (resolve-module mod2520) var2516)) (modref-cont2517 mod2520 var2516 (quote #f)) (bare-cont2518 var2516)) (syntax-violation (quote #f) (quote "bad module kind") var2516 mod2520)))))))))) (build-lexical-assignment1762 (lambda (source2522 name2523 var2524 exp2525) (let ((t2526 (fluid-ref *mode*1750))) (if (memv t2526 (quote (c))) ((@ (language tree-il) make-lexical-set) source2522 name2523 var2524 exp2525) (list (quote set!) var2524 exp2525))))) (build-lexical-reference1761 (lambda (type2527 source2528 name2529 var2530) (let ((t2531 (fluid-ref *mode*1750))) (if (memv t2531 (quote (c))) ((@ (language tree-il) make-lexical-ref) source2528 name2529 var2530) var2530)))) (build-conditional1760 (lambda (source2532 test-exp2533 then-exp2534 else-exp2535) (let ((t2536 (fluid-ref *mode*1750))) (if (memv t2536 (quote (c))) ((@ (language tree-il) make-conditional) source2532 test-exp2533 then-exp2534 else-exp2535) (list (quote if) test-exp2533 then-exp2534 else-exp2535))))) (build-application1759 (lambda (source2537 fun-exp2538 arg-exps2539) (let ((t2540 (fluid-ref *mode*1750))) (if (memv t2540 (quote (c))) ((@ (language tree-il) make-application) source2537 fun-exp2538 arg-exps2539) (cons fun-exp2538 arg-exps2539))))) (get-global-definition-hook1758 (lambda (symbol2541 module2542) (begin (if (and (not module2542) (current-module)) (warn (quote "module system is booted, we should have a module") symbol2541)) (let ((v2543 (module-variable (if module2542 (resolve-module (cdr module2542)) (current-module)) symbol2541))) (and v2543 (variable-bound? v2543) (let ((val2544 (variable-ref v2543))) (and (macro? val2544) (syncase-macro-type val2544) (cons (syncase-macro-type val2544) (syncase-macro-binding val2544))))))))) (put-global-definition-hook1757 (lambda (symbol2545 type2546 val2547) (let ((existing2548 (let ((v2549 (module-variable (current-module) symbol2545))) (and v2549 (variable-bound? v2549) (let ((val2550 (variable-ref v2549))) (and (macro? val2550) (not (syncase-macro-type val2550)) val2550)))))) (module-define! (current-module) symbol2545 (if existing2548 (make-extended-syncase-macro existing2548 type2546 val2547) (make-syncase-macro type2546 val2547)))))) (local-eval-hook1756 (lambda (x2551 mod2552) (primitive-eval (list noexpand1749 (let ((t2553 (fluid-ref *mode*1750))) (if (memv t2553 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2551) x2551)))))) (top-level-eval-hook1755 (lambda (x2554 mod2555) (primitive-eval (list noexpand1749 (let ((t2556 (fluid-ref *mode*1750))) (if (memv t2556 (quote (c))) ((@ (language tree-il) tree-il->scheme) x2554) x2554)))))) (fx<1754 <) (fx=1753 =) (fx-1752 -) (fx+1751 +) (*mode*1750 (make-fluid)) (noexpand1749 (quote "noexpand"))) (begin (global-extend1789 (quote local-syntax) (quote letrec-syntax) (quote #t)) (global-extend1789 (quote local-syntax) (quote let-syntax) (quote #f)) (global-extend1789 (quote core) (quote fluid-let-syntax) (lambda (e2557 r2558 w2559 s2560 mod2561) ((lambda (tmp2562) ((lambda (tmp2563) (if (if tmp2563 (apply (lambda (_2564 var2565 val2566 e12567 e22568) (valid-bound-ids?1816 var2565)) tmp2563) (quote #f)) (apply (lambda (_2570 var2571 val2572 e12573 e22574) (let ((names2575 (map (lambda (x2576) (id-var-name1813 x2576 w2559)) var2571))) (begin (for-each (lambda (id2578 n2579) (let ((t2580 (binding-type1783 (lookup1788 n2579 r2558 mod2561)))) (if (memv t2580 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) (quote "identifier out of context") e2557 (source-wrap1820 id2578 w2559 s2560 mod2561))))) var2571 names2575) (chi-body1831 (cons e12573 e22574) (source-wrap1820 e2557 w2559 s2560 mod2561) (extend-env1785 names2575 (let ((trans-r2583 (macros-only-env1787 r2558))) (map (lambda (x2584) (cons (quote macro) (eval-local-transformer1834 (chi1827 x2584 trans-r2583 w2559 mod2561) mod2561))) val2572)) r2558) w2559 mod2561)))) tmp2563) ((lambda (_2586) (syntax-violation (quote fluid-let-syntax) (quote "bad syntax") (source-wrap1820 e2557 w2559 s2560 mod2561))) tmp2562))) ($sc-dispatch tmp2562 (quote (any #(each (any any)) any . each-any))))) e2557))) (global-extend1789 (quote core) (quote quote) (lambda (e2587 r2588 w2589 s2590 mod2591) ((lambda (tmp2592) ((lambda (tmp2593) (if tmp2593 (apply (lambda (_2594 e2595) (build-data1769 s2590 (strip1838 e2595 w2589))) tmp2593) ((lambda (_2596) (syntax-violation (quote quote) (quote "bad syntax") (source-wrap1820 e2587 w2589 s2590 mod2591))) tmp2592))) ($sc-dispatch tmp2592 (quote (any any))))) e2587))) (global-extend1789 (quote core) (quote syntax) (letrec ((regen2604 (lambda (x2605) (let ((t2606 (car x2605))) (if (memv t2606 (quote (ref))) (build-lexical-reference1761 (quote value) (quote #f) (cadr x2605) (cadr x2605)) (if (memv t2606 (quote (primitive))) (build-primref1768 (quote #f) (cadr x2605)) (if (memv t2606 (quote (quote))) (build-data1769 (quote #f) (cadr x2605)) (if (memv t2606 (quote (lambda))) (build-lambda1767 (quote #f) (cadr x2605) (quote #f) (regen2604 (caddr x2605))) (if (memv t2606 (quote (map))) (let ((ls2607 (map regen2604 (cdr x2605)))) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote map)) ls2607)) (build-application1759 (quote #f) (build-primref1768 (quote #f) (car x2605)) (map regen2604 (cdr x2605))))))))))) (gen-vector2603 (lambda (x2608) (cond ((eq? (car x2608) (quote list)) (cons (quote vector) (cdr x2608))) ((eq? (car x2608) (quote quote)) (list (quote quote) (list->vector (cadr x2608)))) (else (list (quote list->vector) x2608))))) (gen-append2602 (lambda (x2609 y2610) (if (equal? y2610 (quote (quote ()))) x2609 (list (quote append) x2609 y2610)))) (gen-cons2601 (lambda (x2611 y2612) (let ((t2613 (car y2612))) (if (memv t2613 (quote (quote))) (if (eq? (car x2611) (quote quote)) (list (quote quote) (cons (cadr x2611) (cadr y2612))) (if (eq? (cadr y2612) (quote ())) (list (quote list) x2611) (list (quote cons) x2611 y2612))) (if (memv t2613 (quote (list))) (cons (quote list) (cons x2611 (cdr y2612))) (list (quote cons) x2611 y2612)))))) (gen-map2600 (lambda (e2614 map-env2615) (let ((formals2616 (map cdr map-env2615)) (actuals2617 (map (lambda (x2618) (list (quote ref) (car x2618))) map-env2615))) (cond ((eq? (car e2614) (quote ref)) (car actuals2617)) ((and-map (lambda (x2619) (and (eq? (car x2619) (quote ref)) (memq (cadr x2619) formals2616))) (cdr e2614)) (cons (quote map) (cons (list (quote primitive) (car e2614)) (map (let ((r2620 (map cons formals2616 actuals2617))) (lambda (x2621) (cdr (assq (cadr x2621) r2620)))) (cdr e2614))))) (else (cons (quote map) (cons (list (quote lambda) formals2616 e2614) actuals2617))))))) (gen-mappend2599 (lambda (e2622 map-env2623) (list (quote apply) (quote (primitive append)) (gen-map2600 e2622 map-env2623)))) (gen-ref2598 (lambda (src2624 var2625 level2626 maps2627) (if (fx=1753 level2626 (quote 0)) (values var2625 maps2627) (if (null? maps2627) (syntax-violation (quote syntax) (quote "missing ellipsis") src2624) (call-with-values (lambda () (gen-ref2598 src2624 var2625 (fx-1752 level2626 (quote 1)) (cdr maps2627))) (lambda (outer-var2628 outer-maps2629) (let ((b2630 (assq outer-var2628 (car maps2627)))) (if b2630 (values (cdr b2630) maps2627) (let ((inner-var2631 (gen-var1839 (quote tmp)))) (values inner-var2631 (cons (cons (cons outer-var2628 inner-var2631) (car maps2627)) outer-maps2629))))))))))) (gen-syntax2597 (lambda (src2632 e2633 r2634 maps2635 ellipsis?2636 mod2637) (if (id?1791 e2633) (let ((label2638 (id-var-name1813 e2633 (quote (()))))) (let ((b2639 (lookup1788 label2638 r2634 mod2637))) (if (eq? (binding-type1783 b2639) (quote syntax)) (call-with-values (lambda () (let ((var.lev2640 (binding-value1784 b2639))) (gen-ref2598 src2632 (car var.lev2640) (cdr var.lev2640) maps2635))) (lambda (var2641 maps2642) (values (list (quote ref) var2641) maps2642))) (if (ellipsis?2636 e2633) (syntax-violation (quote syntax) (quote "misplaced ellipsis") src2632) (values (list (quote quote) e2633) maps2635))))) ((lambda (tmp2643) ((lambda (tmp2644) (if (if tmp2644 (apply (lambda (dots2645 e2646) (ellipsis?2636 dots2645)) tmp2644) (quote #f)) (apply (lambda (dots2647 e2648) (gen-syntax2597 src2632 e2648 r2634 maps2635 (lambda (x2649) (quote #f)) mod2637)) tmp2644) ((lambda (tmp2650) (if (if tmp2650 (apply (lambda (x2651 dots2652 y2653) (ellipsis?2636 dots2652)) tmp2650) (quote #f)) (apply (lambda (x2654 dots2655 y2656) (letrec ((f2657 (lambda (y2658 k2659) ((lambda (tmp2663) ((lambda (tmp2664) (if (if tmp2664 (apply (lambda (dots2665 y2666) (ellipsis?2636 dots2665)) tmp2664) (quote #f)) (apply (lambda (dots2667 y2668) (f2657 y2668 (lambda (maps2669) (call-with-values (lambda () (k2659 (cons (quote ()) maps2669))) (lambda (x2670 maps2671) (if (null? (car maps2671)) (syntax-violation (quote syntax) (quote "extra ellipsis") src2632) (values (gen-mappend2599 x2670 (car maps2671)) (cdr maps2671)))))))) tmp2664) ((lambda (_2672) (call-with-values (lambda () (gen-syntax2597 src2632 y2658 r2634 maps2635 ellipsis?2636 mod2637)) (lambda (y2673 maps2674) (call-with-values (lambda () (k2659 maps2674)) (lambda (x2675 maps2676) (values (gen-append2602 x2675 y2673) maps2676)))))) tmp2663))) ($sc-dispatch tmp2663 (quote (any . any))))) y2658)))) (f2657 y2656 (lambda (maps2660) (call-with-values (lambda () (gen-syntax2597 src2632 x2654 r2634 (cons (quote ()) maps2660) ellipsis?2636 mod2637)) (lambda (x2661 maps2662) (if (null? (car maps2662)) (syntax-violation (quote syntax) (quote "extra ellipsis") src2632) (values (gen-map2600 x2661 (car maps2662)) (cdr maps2662))))))))) tmp2650) ((lambda (tmp2677) (if tmp2677 (apply (lambda (x2678 y2679) (call-with-values (lambda () (gen-syntax2597 src2632 x2678 r2634 maps2635 ellipsis?2636 mod2637)) (lambda (x2680 maps2681) (call-with-values (lambda () (gen-syntax2597 src2632 y2679 r2634 maps2681 ellipsis?2636 mod2637)) (lambda (y2682 maps2683) (values (gen-cons2601 x2680 y2682) maps2683)))))) tmp2677) ((lambda (tmp2684) (if tmp2684 (apply (lambda (e12685 e22686) (call-with-values (lambda () (gen-syntax2597 src2632 (cons e12685 e22686) r2634 maps2635 ellipsis?2636 mod2637)) (lambda (e2688 maps2689) (values (gen-vector2603 e2688) maps2689)))) tmp2684) ((lambda (_2690) (values (list (quote quote) e2633) maps2635)) tmp2643))) ($sc-dispatch tmp2643 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp2643 (quote (any . any)))))) ($sc-dispatch tmp2643 (quote (any any . any)))))) ($sc-dispatch tmp2643 (quote (any any))))) e2633))))) (lambda (e2691 r2692 w2693 s2694 mod2695) (let ((e2696 (source-wrap1820 e2691 w2693 s2694 mod2695))) ((lambda (tmp2697) ((lambda (tmp2698) (if tmp2698 (apply (lambda (_2699 x2700) (call-with-values (lambda () (gen-syntax2597 e2696 x2700 r2692 (quote ()) ellipsis?1836 mod2695)) (lambda (e2701 maps2702) (regen2604 e2701)))) tmp2698) ((lambda (_2703) (syntax-violation (quote syntax) (quote "bad `syntax' form") e2696)) tmp2697))) ($sc-dispatch tmp2697 (quote (any any))))) e2696))))) (global-extend1789 (quote core) (quote lambda) (lambda (e2704 r2705 w2706 s2707 mod2708) ((lambda (tmp2709) ((lambda (tmp2710) (if tmp2710 (apply (lambda (_2711 c2712) (chi-lambda-clause1832 (source-wrap1820 e2704 w2706 s2707 mod2708) (quote #f) c2712 r2705 w2706 mod2708 (lambda (vars2713 docstring2714 body2715) (build-lambda1767 s2707 vars2713 docstring2714 body2715)))) tmp2710) (syntax-violation #f "source expression failed to match any pattern" tmp2709))) ($sc-dispatch tmp2709 (quote (any . any))))) e2704))) (global-extend1789 (quote core) (quote let) (letrec ((chi-let2716 (lambda (e2717 r2718 w2719 s2720 mod2721 constructor2722 ids2723 vals2724 exps2725) (if (not (valid-bound-ids?1816 ids2723)) (syntax-violation (quote let) (quote "duplicate bound variable") e2717) (let ((labels2726 (gen-labels1797 ids2723)) (new-vars2727 (map gen-var1839 ids2723))) (let ((nw2728 (make-binding-wrap1808 ids2723 labels2726 w2719)) (nr2729 (extend-var-env1786 labels2726 new-vars2727 r2718))) (constructor2722 s2720 new-vars2727 (map (lambda (x2730) (chi1827 x2730 r2718 w2719 mod2721)) vals2724) (chi-body1831 exps2725 (source-wrap1820 e2717 nw2728 s2720 mod2721) nr2729 nw2728 mod2721)))))))) (lambda (e2731 r2732 w2733 s2734 mod2735) ((lambda (tmp2736) ((lambda (tmp2737) (if tmp2737 (apply (lambda (_2738 id2739 val2740 e12741 e22742) (chi-let2716 e2731 r2732 w2733 s2734 mod2735 build-let1771 id2739 val2740 (cons e12741 e22742))) tmp2737) ((lambda (tmp2746) (if (if tmp2746 (apply (lambda (_2747 f2748 id2749 val2750 e12751 e22752) (id?1791 f2748)) tmp2746) (quote #f)) (apply (lambda (_2753 f2754 id2755 val2756 e12757 e22758) (chi-let2716 e2731 r2732 w2733 s2734 mod2735 build-named-let1772 (cons f2754 id2755) val2756 (cons e12757 e22758))) tmp2746) ((lambda (_2762) (syntax-violation (quote let) (quote "bad let") (source-wrap1820 e2731 w2733 s2734 mod2735))) tmp2736))) ($sc-dispatch tmp2736 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp2736 (quote (any #(each (any any)) any . each-any))))) e2731)))) (global-extend1789 (quote core) (quote letrec) (lambda (e2763 r2764 w2765 s2766 mod2767) ((lambda (tmp2768) ((lambda (tmp2769) (if tmp2769 (apply (lambda (_2770 id2771 val2772 e12773 e22774) (let ((ids2775 id2771)) (if (not (valid-bound-ids?1816 ids2775)) (syntax-violation (quote letrec) (quote "duplicate bound variable") e2763) (let ((labels2777 (gen-labels1797 ids2775)) (new-vars2778 (map gen-var1839 ids2775))) (let ((w2779 (make-binding-wrap1808 ids2775 labels2777 w2765)) (r2780 (extend-var-env1786 labels2777 new-vars2778 r2764))) (build-letrec1773 s2766 new-vars2778 (map (lambda (x2781) (chi1827 x2781 r2780 w2779 mod2767)) val2772) (chi-body1831 (cons e12773 e22774) (source-wrap1820 e2763 w2779 s2766 mod2767) r2780 w2779 mod2767))))))) tmp2769) ((lambda (_2784) (syntax-violation (quote letrec) (quote "bad letrec") (source-wrap1820 e2763 w2765 s2766 mod2767))) tmp2768))) ($sc-dispatch tmp2768 (quote (any #(each (any any)) any . each-any))))) e2763))) (global-extend1789 (quote core) (quote set!) (lambda (e2785 r2786 w2787 s2788 mod2789) ((lambda (tmp2790) ((lambda (tmp2791) (if (if tmp2791 (apply (lambda (_2792 id2793 val2794) (id?1791 id2793)) tmp2791) (quote #f)) (apply (lambda (_2795 id2796 val2797) (let ((val2798 (chi1827 val2797 r2786 w2787 mod2789)) (n2799 (id-var-name1813 id2796 w2787))) (let ((b2800 (lookup1788 n2799 r2786 mod2789))) (let ((t2801 (binding-type1783 b2800))) (if (memv t2801 (quote (lexical))) (build-lexical-assignment1762 s2788 (syntax->datum id2796) (binding-value1784 b2800) val2798) (if (memv t2801 (quote (global))) (build-global-assignment1765 s2788 n2799 val2798 mod2789) (if (memv t2801 (quote (displaced-lexical))) (syntax-violation (quote set!) (quote "identifier out of context") (wrap1819 id2796 w2787 mod2789)) (syntax-violation (quote set!) (quote "bad set!") (source-wrap1820 e2785 w2787 s2788 mod2789))))))))) tmp2791) ((lambda (tmp2802) (if tmp2802 (apply (lambda (_2803 head2804 tail2805 val2806) (call-with-values (lambda () (syntax-type1825 head2804 r2786 (quote (())) (quote #f) (quote #f) mod2789)) (lambda (type2807 value2808 ee2809 ww2810 ss2811 modmod2812) (let ((t2813 type2807)) (if (memv t2813 (quote (module-ref))) (let ((val2814 (chi1827 val2806 r2786 w2787 mod2789))) (call-with-values (lambda () (value2808 (cons head2804 tail2805))) (lambda (id2816 mod2817) (build-global-assignment1765 s2788 id2816 val2814 mod2817)))) (build-application1759 s2788 (chi1827 (list (quote #(syntax-object setter ((top) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(type value ee ww ss modmod) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage #(_ head tail val) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w s mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) head2804) r2786 w2787 mod2789) (map (lambda (e2818) (chi1827 e2818 r2786 w2787 mod2789)) (append tail2805 (list val2806))))))))) tmp2802) ((lambda (_2820) (syntax-violation (quote set!) (quote "bad set!") (source-wrap1820 e2785 w2787 s2788 mod2789))) tmp2790))) ($sc-dispatch tmp2790 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp2790 (quote (any any any))))) e2785))) (global-extend1789 (quote module-ref) (quote @) (lambda (e2821) ((lambda (tmp2822) ((lambda (tmp2823) (if (if tmp2823 (apply (lambda (_2824 mod2825 id2826) (and (and-map id?1791 mod2825) (id?1791 id2826))) tmp2823) (quote #f)) (apply (lambda (_2828 mod2829 id2830) (values (syntax->datum id2830) (syntax->datum (cons (quote #(syntax-object public ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2829)))) tmp2823) (syntax-violation #f "source expression failed to match any pattern" tmp2822))) ($sc-dispatch tmp2822 (quote (any each-any any))))) e2821))) (global-extend1789 (quote module-ref) (quote @@) (lambda (e2832) ((lambda (tmp2833) ((lambda (tmp2834) (if (if tmp2834 (apply (lambda (_2835 mod2836 id2837) (and (and-map id?1791 mod2836) (id?1791 id2837))) tmp2834) (quote #f)) (apply (lambda (_2839 mod2840 id2841) (values (syntax->datum id2841) (syntax->datum (cons (quote #(syntax-object private ((top) #(ribcage #(_ mod id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) mod2840)))) tmp2834) (syntax-violation #f "source expression failed to match any pattern" tmp2833))) ($sc-dispatch tmp2833 (quote (any each-any any))))) e2832))) (global-extend1789 (quote begin) (quote begin) (quote ())) (global-extend1789 (quote define) (quote define) (quote ())) (global-extend1789 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend1789 (quote eval-when) (quote eval-when) (quote ())) (global-extend1789 (quote core) (quote syntax-case) (letrec ((gen-syntax-case2846 (lambda (x2847 keys2848 clauses2849 r2850 mod2851) (if (null? clauses2849) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote syntax-violation)) (list (quote #f) (quote "source expression failed to match any pattern") x2847)) ((lambda (tmp2852) ((lambda (tmp2853) (if tmp2853 (apply (lambda (pat2854 exp2855) (if (and (id?1791 pat2854) (and-map (lambda (x2856) (not (free-id=?1814 pat2854 x2856))) (cons (quote #(syntax-object ... ((top) #(ribcage #(pat exp) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x keys clauses r mod) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (gen-syntax-case gen-clause build-dispatch-call convert-pattern) ((top) (top) (top) (top)) ("i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip-annotation ellipsis? chi-void eval-local-transformer chi-local-syntax chi-lambda-clause chi-body chi-macro chi-application chi-expr chi chi-top syntax-type chi-when-list chi-install-global chi-top-sequence chi-sequence source-wrap wrap bound-id-member? distinct-bound-ids? valid-bound-ids? bound-id=? free-id=? 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 unannotate 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 build-global-definition build-global-assignment build-global-reference analyze-variable build-lexical-assignment build-lexical-reference build-conditional build-application get-global-definition-hook put-global-definition-hook gensym-hook local-eval-hook top-level-eval-hook fx< fx= fx- fx+ *mode* noexpand) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(ribcage (define-structure and-map*) ((top) (top)) ("i" "i"))) (hygiene guile))) keys2848))) (let ((labels2857 (list (gen-label1796))) (var2858 (gen-var1839 pat2854))) (build-application1759 (quote #f) (build-lambda1767 (quote #f) (list var2858) (quote #f) (chi1827 exp2855 (extend-env1785 labels2857 (list (cons (quote syntax) (cons var2858 (quote 0)))) r2850) (make-binding-wrap1808 (list pat2854) labels2857 (quote (()))) mod2851)) (list x2847))) (gen-clause2845 x2847 keys2848 (cdr clauses2849) r2850 pat2854 (quote #t) exp2855 mod2851))) tmp2853) ((lambda (tmp2859) (if tmp2859 (apply (lambda (pat2860 fender2861 exp2862) (gen-clause2845 x2847 keys2848 (cdr clauses2849) r2850 pat2860 fender2861 exp2862 mod2851)) tmp2859) ((lambda (_2863) (syntax-violation (quote syntax-case) (quote "invalid clause") (car clauses2849))) tmp2852))) ($sc-dispatch tmp2852 (quote (any any any)))))) ($sc-dispatch tmp2852 (quote (any any))))) (car clauses2849))))) (gen-clause2845 (lambda (x2864 keys2865 clauses2866 r2867 pat2868 fender2869 exp2870 mod2871) (call-with-values (lambda () (convert-pattern2843 pat2868 keys2865)) (lambda (p2872 pvars2873) (cond ((not (distinct-bound-ids?1817 (map car pvars2873))) (syntax-violation (quote syntax-case) (quote "duplicate pattern variable") pat2868)) ((not (and-map (lambda (x2874) (not (ellipsis?1836 (car x2874)))) pvars2873)) (syntax-violation (quote syntax-case) (quote "misplaced ellipsis") pat2868)) (else (let ((y2875 (gen-var1839 (quote tmp)))) (build-application1759 (quote #f) (build-lambda1767 (quote #f) (list y2875) (quote #f) (let ((y2876 (build-lexical-reference1761 (quote value) (quote #f) (quote tmp) y2875))) (build-conditional1760 (quote #f) ((lambda (tmp2877) ((lambda (tmp2878) (if tmp2878 (apply (lambda () y2876) tmp2878) ((lambda (_2879) (build-conditional1760 (quote #f) y2876 (build-dispatch-call2844 pvars2873 fender2869 y2876 r2867 mod2871) (build-data1769 (quote #f) (quote #f)))) tmp2877))) ($sc-dispatch tmp2877 (quote #(atom #t))))) fender2869) (build-dispatch-call2844 pvars2873 exp2870 y2876 r2867 mod2871) (gen-syntax-case2846 x2864 keys2865 clauses2866 r2867 mod2871)))) (list (if (eq? p2872 (quote any)) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote list)) (list x2864)) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote $sc-dispatch)) (list x2864 (build-data1769 (quote #f) p2872))))))))))))) (build-dispatch-call2844 (lambda (pvars2880 exp2881 y2882 r2883 mod2884) (let ((ids2885 (map car pvars2880)) (levels2886 (map cdr pvars2880))) (let ((labels2887 (gen-labels1797 ids2885)) (new-vars2888 (map gen-var1839 ids2885))) (build-application1759 (quote #f) (build-primref1768 (quote #f) (quote apply)) (list (build-lambda1767 (quote #f) new-vars2888 (quote #f) (chi1827 exp2881 (extend-env1785 labels2887 (map (lambda (var2889 level2890) (cons (quote syntax) (cons var2889 level2890))) new-vars2888 (map cdr pvars2880)) r2883) (make-binding-wrap1808 ids2885 labels2887 (quote (()))) mod2884)) y2882)))))) (convert-pattern2843 (lambda (pattern2891 keys2892) (letrec ((cvt2893 (lambda (p2894 n2895 ids2896) (if (id?1791 p2894) (if (bound-id-member?1818 p2894 keys2892) (values (vector (quote free-id) p2894) ids2896) (values (quote any) (cons (cons p2894 n2895) ids2896))) ((lambda (tmp2897) ((lambda (tmp2898) (if (if tmp2898 (apply (lambda (x2899 dots2900) (ellipsis?1836 dots2900)) tmp2898) (quote #f)) (apply (lambda (x2901 dots2902) (call-with-values (lambda () (cvt2893 x2901 (fx+1751 n2895 (quote 1)) ids2896)) (lambda (p2903 ids2904) (values (if (eq? p2903 (quote any)) (quote each-any) (vector (quote each) p2903)) ids2904)))) tmp2898) ((lambda (tmp2905) (if tmp2905 (apply (lambda (x2906 y2907) (call-with-values (lambda () (cvt2893 y2907 n2895 ids2896)) (lambda (y2908 ids2909) (call-with-values (lambda () (cvt2893 x2906 n2895 ids2909)) (lambda (x2910 ids2911) (values (cons x2910 y2908) ids2911)))))) tmp2905) ((lambda (tmp2912) (if tmp2912 (apply (lambda () (values (quote ()) ids2896)) tmp2912) ((lambda (tmp2913) (if tmp2913 (apply (lambda (x2914) (call-with-values (lambda () (cvt2893 x2914 n2895 ids2896)) (lambda (p2916 ids2917) (values (vector (quote vector) p2916) ids2917)))) tmp2913) ((lambda (x2918) (values (vector (quote atom) (strip1838 p2894 (quote (())))) ids2896)) tmp2897))) ($sc-dispatch tmp2897 (quote #(vector each-any)))))) ($sc-dispatch tmp2897 (quote ()))))) ($sc-dispatch tmp2897 (quote (any . any)))))) ($sc-dispatch tmp2897 (quote (any any))))) p2894))))) (cvt2893 pattern2891 (quote 0) (quote ())))))) (lambda (e2919 r2920 w2921 s2922 mod2923) (let ((e2924 (source-wrap1820 e2919 w2921 s2922 mod2923))) ((lambda (tmp2925) ((lambda (tmp2926) (if tmp2926 (apply (lambda (_2927 val2928 key2929 m2930) (if (and-map (lambda (x2931) (and (id?1791 x2931) (not (ellipsis?1836 x2931)))) key2929) (let ((x2933 (gen-var1839 (quote tmp)))) (build-application1759 s2922 (build-lambda1767 (quote #f) (list x2933) (quote #f) (gen-syntax-case2846 (build-lexical-reference1761 (quote value) (quote #f) (quote tmp) x2933) key2929 m2930 r2920 mod2923)) (list (chi1827 val2928 r2920 (quote (())) mod2923)))) (syntax-violation (quote syntax-case) (quote "invalid literals list") e2924))) tmp2926) (syntax-violation #f "source expression failed to match any pattern" tmp2925))) ($sc-dispatch tmp2925 (quote (any any each-any . each-any))))) e2924))))) (set! sc-expand (lambda (x2937 . rest2936) (if (and (pair? x2937) (equal? (car x2937) noexpand1749)) (cadr x2937) (let ((m2938 (if (null? rest2936) (quote e) (car rest2936))) (esew2939 (if (or (null? rest2936) (null? (cdr rest2936))) (quote (eval)) (cadr rest2936)))) (with-fluid* *mode*1750 m2938 (lambda () (chi-top1826 x2937 (quote ()) (quote ((top))) m2938 esew2939 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x2940) (nonsymbol-id?1790 x2940))) (set! datum->syntax (lambda (id2941 datum2942) (make-syntax-object1774 datum2942 (syntax-object-wrap1777 id2941) (quote #f)))) (set! syntax->datum (lambda (x2943) (strip1838 x2943 (quote (()))))) (set! generate-temporaries (lambda (ls2944) (begin (let ((x2945 ls2944)) (if (not (list? x2945)) (syntax-violation (quote generate-temporaries) (quote "invalid argument") x2945))) (map (lambda (x2946) (wrap1819 (gensym) (quote ((top))) (quote #f))) ls2944)))) (set! free-identifier=? (lambda (x2947 y2948) (begin (let ((x2949 x2947)) (if (not (nonsymbol-id?1790 x2949)) (syntax-violation (quote free-identifier=?) (quote "invalid argument") x2949))) (let ((x2950 y2948)) (if (not (nonsymbol-id?1790 x2950)) (syntax-violation (quote free-identifier=?) (quote "invalid argument") x2950))) (free-id=?1814 x2947 y2948)))) (set! bound-identifier=? (lambda (x2951 y2952) (begin (let ((x2953 x2951)) (if (not (nonsymbol-id?1790 x2953)) (syntax-violation (quote bound-identifier=?) (quote "invalid argument") x2953))) (let ((x2954 y2952)) (if (not (nonsymbol-id?1790 x2954)) (syntax-violation (quote bound-identifier=?) (quote "invalid argument") x2954))) (bound-id=?1815 x2951 y2952)))) (set! syntax-violation (lambda (who2958 message2957 form2956 . subform2955) (begin (let ((x2959 who2958)) (if (not ((lambda (x2960) (or (not x2960) (string? x2960) (symbol? x2960))) x2959)) (syntax-violation (quote syntax-violation) (quote "invalid argument") x2959))) (let ((x2961 message2957)) (if (not (string? x2961)) (syntax-violation (quote syntax-violation) (quote "invalid argument") x2961))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who2958 (quote "~a: ") (quote "")) (quote "~a ") (if (null? subform2955) (quote "in ~a") (quote "in subform `~s' of `~s'"))) (let ((tail2962 (cons message2957 (map (lambda (x2963) (strip1838 x2963 (quote (())))) (append subform2955 (list form2956)))))) (if who2958 (cons who2958 tail2962) tail2962)) (quote #f))))) (letrec ((match2968 (lambda (e2969 p2970 w2971 r2972 mod2973) (cond ((not r2972) (quote #f)) ((eq? p2970 (quote any)) (cons (wrap1819 e2969 w2971 mod2973) r2972)) ((syntax-object?1775 e2969) (match*2967 (let ((e2974 (syntax-object-expression1776 e2969))) (if (annotation? e2974) (annotation-expression e2974) e2974)) p2970 (join-wraps1810 w2971 (syntax-object-wrap1777 e2969)) r2972 (syntax-object-module1778 e2969))) (else (match*2967 (let ((e2975 e2969)) (if (annotation? e2975) (annotation-expression e2975) e2975)) p2970 w2971 r2972 mod2973))))) (match*2967 (lambda (e2976 p2977 w2978 r2979 mod2980) (cond ((null? p2977) (and (null? e2976) r2979)) ((pair? p2977) (and (pair? e2976) (match2968 (car e2976) (car p2977) w2978 (match2968 (cdr e2976) (cdr p2977) w2978 r2979 mod2980) mod2980))) ((eq? p2977 (quote each-any)) (let ((l2981 (match-each-any2965 e2976 w2978 mod2980))) (and l2981 (cons l2981 r2979)))) (else (let ((t2982 (vector-ref p2977 (quote 0)))) (if (memv t2982 (quote (each))) (if (null? e2976) (match-empty2966 (vector-ref p2977 (quote 1)) r2979) (let ((l2983 (match-each2964 e2976 (vector-ref p2977 (quote 1)) w2978 mod2980))) (and l2983 (letrec ((collect2984 (lambda (l2985) (if (null? (car l2985)) r2979 (cons (map car l2985) (collect2984 (map cdr l2985))))))) (collect2984 l2983))))) (if (memv t2982 (quote (free-id))) (and (id?1791 e2976) (free-id=?1814 (wrap1819 e2976 w2978 mod2980) (vector-ref p2977 (quote 1))) r2979) (if (memv t2982 (quote (atom))) (and (equal? (vector-ref p2977 (quote 1)) (strip1838 e2976 w2978)) r2979) (if (memv t2982 (quote (vector))) (and (vector? e2976) (match2968 (vector->list e2976) (vector-ref p2977 (quote 1)) w2978 r2979 mod2980))))))))))) (match-empty2966 (lambda (p2986 r2987) (cond ((null? p2986) r2987) ((eq? p2986 (quote any)) (cons (quote ()) r2987)) ((pair? p2986) (match-empty2966 (car p2986) (match-empty2966 (cdr p2986) r2987))) ((eq? p2986 (quote each-any)) (cons (quote ()) r2987)) (else (let ((t2988 (vector-ref p2986 (quote 0)))) (if (memv t2988 (quote (each))) (match-empty2966 (vector-ref p2986 (quote 1)) r2987) (if (memv t2988 (quote (free-id atom))) r2987 (if (memv t2988 (quote (vector))) (match-empty2966 (vector-ref p2986 (quote 1)) r2987))))))))) (match-each-any2965 (lambda (e2989 w2990 mod2991) (cond ((annotation? e2989) (match-each-any2965 (annotation-expression e2989) w2990 mod2991)) ((pair? e2989) (let ((l2992 (match-each-any2965 (cdr e2989) w2990 mod2991))) (and l2992 (cons (wrap1819 (car e2989) w2990 mod2991) l2992)))) ((null? e2989) (quote ())) ((syntax-object?1775 e2989) (match-each-any2965 (syntax-object-expression1776 e2989) (join-wraps1810 w2990 (syntax-object-wrap1777 e2989)) mod2991)) (else (quote #f))))) (match-each2964 (lambda (e2993 p2994 w2995 mod2996) (cond ((annotation? e2993) (match-each2964 (annotation-expression e2993) p2994 w2995 mod2996)) ((pair? e2993) (let ((first2997 (match2968 (car e2993) p2994 w2995 (quote ()) mod2996))) (and first2997 (let ((rest2998 (match-each2964 (cdr e2993) p2994 w2995 mod2996))) (and rest2998 (cons first2997 rest2998)))))) ((null? e2993) (quote ())) ((syntax-object?1775 e2993) (match-each2964 (syntax-object-expression1776 e2993) p2994 (join-wraps1810 w2995 (syntax-object-wrap1777 e2993)) (syntax-object-module1778 e2993))) (else (quote #f)))))) (set! $sc-dispatch (lambda (e2999 p3000) (cond ((eq? p3000 (quote any)) (list e2999)) ((syntax-object?1775 e2999) (match*2967 (let ((e3001 (syntax-object-expression1776 e2999))) (if (annotation? e3001) (annotation-expression e3001) e3001)) p3000 (syntax-object-wrap1777 e2999) (quote ()) (syntax-object-module1778 e2999))) (else (match*2967 (let ((e3002 e2999)) (if (annotation? e3002) (annotation-expression e3002) e3002)) p3000 (quote (())) (quote ()) (quote #f)))))))))) (define with-syntax (make-syncase-macro (quote macro) (lambda (x3003) ((lambda (tmp3004) ((lambda (tmp3005) (if tmp3005 (apply (lambda (_3006 e13007 e23008) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13007 e23008))) tmp3005) ((lambda (tmp3010) (if tmp3010 (apply (lambda (_3011 out3012 in3013 e13014 e23015) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in3013 (quote ()) (list out3012 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13014 e23015))))) tmp3010) ((lambda (tmp3017) (if tmp3017 (apply (lambda (_3018 out3019 in3020 e13021 e23022) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) in3020) (quote ()) (list out3019 (cons (quote #(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13021 e23022))))) tmp3017) (syntax-violation #f "source expression failed to match any pattern" tmp3004))) ($sc-dispatch tmp3004 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp3004 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp3004 (quote (any () any . each-any))))) x3003)))) (define syntax-rules (make-syncase-macro (quote macro) (lambda (x3026) ((lambda (tmp3027) ((lambda (tmp3028) (if tmp3028 (apply (lambda (_3029 k3030 keyword3031 pattern3032 template3033) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (cons (quote #(syntax-object syntax-case ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote #(syntax-object x ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons k3030 (map (lambda (tmp3036 tmp3035) (list (cons (quote #(syntax-object dummy ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp3035) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ k keyword pattern template) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) tmp3036))) template3033 pattern3032)))))) tmp3028) (syntax-violation #f "source expression failed to match any pattern" tmp3027))) ($sc-dispatch tmp3027 (quote (any each-any . #(each ((any . any) any))))))) x3026)))) (define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x3037) ((lambda (tmp3038) ((lambda (tmp3039) (if (if tmp3039 (apply (lambda (let*3040 x3041 v3042 e13043 e23044) (and-map identifier? x3041)) tmp3039) (quote #f)) (apply (lambda (let*3046 x3047 v3048 e13049 e23050) (letrec ((f3051 (lambda (bindings3052) (if (null? bindings3052) (cons (quote #(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons (quote ()) (cons e13049 e23050))) ((lambda (tmp3056) ((lambda (tmp3057) (if tmp3057 (apply (lambda (body3058 binding3059) (list (quote #(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f bindings) #((top) (top)) #("i" "i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list binding3059) body3058)) tmp3057) (syntax-violation #f "source expression failed to match any pattern" tmp3056))) ($sc-dispatch tmp3056 (quote (any any))))) (list (f3051 (cdr bindings3052)) (car bindings3052))))))) (f3051 (map list x3047 v3048)))) tmp3039) (syntax-violation #f "source expression failed to match any pattern" tmp3038))) ($sc-dispatch tmp3038 (quote (any #(each (any any)) any . each-any))))) x3037)))) (define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x3060) ((lambda (tmp3061) ((lambda (tmp3062) (if tmp3062 (apply (lambda (_3063 var3064 init3065 step3066 e03067 e13068 c3069) ((lambda (tmp3070) ((lambda (tmp3071) (if tmp3071 (apply (lambda (step3072) ((lambda (tmp3073) ((lambda (tmp3074) (if tmp3074 (apply (lambda () (list (quote #(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var3064 init3065) (list (quote #(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e03067) (cons (quote #(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c3069 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step3072))))))) tmp3074) ((lambda (tmp3079) (if tmp3079 (apply (lambda (e13080 e23081) (list (quote #(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (map list var3064 init3065) (list (quote #(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) e03067 (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (cons e13080 e23081)) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) (append c3069 (list (cons (quote #(syntax-object doloop ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i"))) (hygiene guile))) step3072))))))) tmp3079) (syntax-violation #f "source expression failed to match any pattern" tmp3073))) ($sc-dispatch tmp3073 (quote (any . each-any)))))) ($sc-dispatch tmp3073 (quote ())))) e13068)) tmp3071) (syntax-violation #f "source expression failed to match any pattern" tmp3070))) ($sc-dispatch tmp3070 (quote each-any)))) (map (lambda (v3088 s3089) ((lambda (tmp3090) ((lambda (tmp3091) (if tmp3091 (apply (lambda () v3088) tmp3091) ((lambda (tmp3092) (if tmp3092 (apply (lambda (e3093) e3093) tmp3092) ((lambda (_3094) (syntax-violation (quote do) (quote "bad step expression") orig-x3060 s3089)) tmp3090))) ($sc-dispatch tmp3090 (quote (any)))))) ($sc-dispatch tmp3090 (quote ())))) s3089)) var3064 step3066))) tmp3062) (syntax-violation #f "source expression failed to match any pattern" tmp3061))) ($sc-dispatch tmp3061 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x3060)))) (define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons3097 (lambda (x3101 y3102) ((lambda (tmp3103) ((lambda (tmp3104) (if tmp3104 (apply (lambda (x3105 y3106) ((lambda (tmp3107) ((lambda (tmp3108) (if tmp3108 (apply (lambda (dy3109) ((lambda (tmp3110) ((lambda (tmp3111) (if tmp3111 (apply (lambda (dx3112) (list (quote #(syntax-object quote ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons dx3112 dy3109))) tmp3111) ((lambda (_3113) (if (null? dy3109) (list (quote #(syntax-object list ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3105) (list (quote #(syntax-object cons ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3105 y3106))) tmp3110))) ($sc-dispatch tmp3110 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) x3105)) tmp3108) ((lambda (tmp3114) (if tmp3114 (apply (lambda (stuff3115) (cons (quote #(syntax-object list ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (cons x3105 stuff3115))) tmp3114) ((lambda (else3116) (list (quote #(syntax-object cons ((top) #(ribcage #(else) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3105 y3106)) tmp3107))) ($sc-dispatch tmp3107 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . any)))))) ($sc-dispatch tmp3107 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) y3106)) tmp3104) (syntax-violation #f "source expression failed to match any pattern" tmp3103))) ($sc-dispatch tmp3103 (quote (any any))))) (list x3101 y3102)))) (quasiappend3098 (lambda (x3117 y3118) ((lambda (tmp3119) ((lambda (tmp3120) (if tmp3120 (apply (lambda (x3121 y3122) ((lambda (tmp3123) ((lambda (tmp3124) (if tmp3124 (apply (lambda () x3121) tmp3124) ((lambda (_3125) (list (quote #(syntax-object append ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3121 y3122)) tmp3123))) ($sc-dispatch tmp3123 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) ()))))) y3122)) tmp3120) (syntax-violation #f "source expression failed to match any pattern" tmp3119))) ($sc-dispatch tmp3119 (quote (any any))))) (list x3117 y3118)))) (quasivector3099 (lambda (x3126) ((lambda (tmp3127) ((lambda (x3128) ((lambda (tmp3129) ((lambda (tmp3130) (if tmp3130 (apply (lambda (x3131) (list (quote #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) (list->vector x3131))) tmp3130) ((lambda (tmp3133) (if tmp3133 (apply (lambda (x3134) (cons (quote #(syntax-object vector ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3134)) tmp3133) ((lambda (_3136) (list (quote #(syntax-object list->vector ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) x3128)) tmp3129))) ($sc-dispatch tmp3129 (quote (#(free-id #(syntax-object list ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) . each-any)))))) ($sc-dispatch tmp3129 (quote (#(free-id #(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) each-any))))) x3128)) tmp3127)) x3126))) (quasi3100 (lambda (p3137 lev3138) ((lambda (tmp3139) ((lambda (tmp3140) (if tmp3140 (apply (lambda (p3141) (if (= lev3138 (quote 0)) p3141 (quasicons3097 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3100 (list p3141) (- lev3138 (quote 1)))))) tmp3140) ((lambda (tmp3142) (if tmp3142 (apply (lambda (p3143 q3144) (if (= lev3138 (quote 0)) (quasiappend3098 p3143 (quasi3100 q3144 lev3138)) (quasicons3097 (quasicons3097 (quote (#(syntax-object quote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3100 (list p3143) (- lev3138 (quote 1)))) (quasi3100 q3144 lev3138)))) tmp3142) ((lambda (tmp3145) (if tmp3145 (apply (lambda (p3146) (quasicons3097 (quote (#(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)) #(syntax-object quasiquote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile)))) (quasi3100 (list p3146) (+ lev3138 (quote 1))))) tmp3145) ((lambda (tmp3147) (if tmp3147 (apply (lambda (p3148 q3149) (quasicons3097 (quasi3100 p3148 lev3138) (quasi3100 q3149 lev3138))) tmp3147) ((lambda (tmp3150) (if tmp3150 (apply (lambda (x3151) (quasivector3099 (quasi3100 x3151 lev3138))) tmp3150) ((lambda (p3153) (list (quote #(syntax-object quote ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) p3153)) tmp3139))) ($sc-dispatch tmp3139 (quote #(vector each-any)))))) ($sc-dispatch tmp3139 (quote (any . any)))))) ($sc-dispatch tmp3139 (quote (#(free-id #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any)))))) ($sc-dispatch tmp3139 (quote ((#(free-id #(syntax-object unquote-splicing ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any) . any)))))) ($sc-dispatch tmp3139 (quote (#(free-id #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage #(quasicons quasiappend quasivector quasi) #((top) (top) (top) (top)) #("i" "i" "i" "i"))) (hygiene guile))) any))))) p3137)))) (lambda (x3154) ((lambda (tmp3155) ((lambda (tmp3156) (if tmp3156 (apply (lambda (_3157 e3158) (quasi3100 e3158 (quote 0))) tmp3156) (syntax-violation #f "source expression failed to match any pattern" tmp3155))) ($sc-dispatch tmp3155 (quote (any any))))) x3154))))) (define include (make-syncase-macro (quote macro) (lambda (x3159) (letrec ((read-file3160 (lambda (fn3161 k3162) (let ((p3163 (open-input-file fn3161))) (letrec ((f3164 (lambda (x3165) (if (eof-object? x3165) (begin (close-input-port p3163) (quote ())) (cons (datum->syntax k3162 x3165) (f3164 (read p3163))))))) (f3164 (read p3163))))))) ((lambda (tmp3166) ((lambda (tmp3167) (if tmp3167 (apply (lambda (k3168 filename3169) (let ((fn3170 (syntax->datum filename3169))) ((lambda (tmp3171) ((lambda (tmp3172) (if tmp3172 (apply (lambda (exp3173) (cons (quote #(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) exp3173)) tmp3172) (syntax-violation #f "source expression failed to match any pattern" tmp3171))) ($sc-dispatch tmp3171 (quote each-any)))) (read-file3160 fn3170 k3168)))) tmp3167) (syntax-violation #f "source expression failed to match any pattern" tmp3166))) ($sc-dispatch tmp3166 (quote (any any))))) x3159))))) (define unquote (make-syncase-macro (quote macro) (lambda (x3175) ((lambda (tmp3176) ((lambda (tmp3177) (if tmp3177 (apply (lambda (_3178 e3179) (syntax-violation (quote unquote) (quote "expression not valid outside of quasiquote") x3175)) tmp3177) (syntax-violation #f "source expression failed to match any pattern" tmp3176))) ($sc-dispatch tmp3176 (quote (any any))))) x3175)))) (define unquote-splicing (make-syncase-macro (quote macro) (lambda (x3180) ((lambda (tmp3181) ((lambda (tmp3182) (if tmp3182 (apply (lambda (_3183 e3184) (syntax-violation (quote unquote-splicing) (quote "expression not valid outside of quasiquote") x3180)) tmp3182) (syntax-violation #f "source expression failed to match any pattern" tmp3181))) ($sc-dispatch tmp3181 (quote (any any))))) x3180)))) (define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x3185) ((lambda (tmp3186) ((lambda (tmp3187) (if tmp3187 (apply (lambda (_3188 e3189 m13190 m23191) ((lambda (tmp3192) ((lambda (body3193) (list (quote #(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (list (quote #(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e3189)) body3193)) tmp3192)) (letrec ((f3194 (lambda (clause3195 clauses3196) (if (null? clauses3196) ((lambda (tmp3198) ((lambda (tmp3199) (if tmp3199 (apply (lambda (e13200 e23201) (cons (quote #(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13200 e23201))) tmp3199) ((lambda (tmp3203) (if tmp3203 (apply (lambda (k3204 e13205 e23206) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k3204)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13205 e23206)))) tmp3203) ((lambda (_3209) (syntax-violation (quote case) (quote "bad clause") x3185 clause3195)) tmp3198))) ($sc-dispatch tmp3198 (quote (each-any any . each-any)))))) ($sc-dispatch tmp3198 (quote (#(free-id #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) any . each-any))))) clause3195) ((lambda (tmp3210) ((lambda (rest3211) ((lambda (tmp3212) ((lambda (tmp3213) (if tmp3213 (apply (lambda (k3214 e13215 e23216) (list (quote #(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (list (quote #(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) k3214)) (cons (quote #(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(f clause clauses) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e13215 e23216)) rest3211)) tmp3213) ((lambda (_3219) (syntax-violation (quote case) (quote "bad clause") x3185 clause3195)) tmp3212))) ($sc-dispatch tmp3212 (quote (each-any any . each-any))))) clause3195)) tmp3210)) (f3194 (car clauses3196) (cdr clauses3196))))))) (f3194 m13190 m23191)))) tmp3187) (syntax-violation #f "source expression failed to match any pattern" tmp3186))) ($sc-dispatch tmp3186 (quote (any any any . each-any))))) x3185)))) (define identifier-syntax (make-syncase-macro (quote macro) (lambda (x3220) ((lambda (tmp3221) ((lambda (tmp3222) (if tmp3222 (apply (lambda (_3223 e3224) (list (quote #(syntax-object lambda ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))) (list (quote #(syntax-object syntax-case ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote #(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote ()) (list (quote #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (quote (#(syntax-object identifier? ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) (#(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object id ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) e3224)) (list (cons _3223 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))))) (list (quote #(syntax-object syntax ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e3224 (quote (#(syntax-object x ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)) #(syntax-object ... ((top) #(ribcage #(_ e) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile)))))))))) tmp3222) (syntax-violation #f "source expression failed to match any pattern" tmp3221))) ($sc-dispatch tmp3221 (quote (any any))))) x3220))))