From 06656e06d454f16694d0b550fb339efb0c36123a Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 7 May 2009 17:44:51 +0200 Subject: [PATCH] go ahead and regenerate psyntax-pp.scm --- module/ice-9/psyntax-pp.scm | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) rewrite module/ice-9/psyntax-pp.scm (77%) diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm dissimilarity index 77% index 2718a1e87..dca1b30f6 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -1,13 +1,13 @@ -(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)))) +(eval-when (compile) (set-current-module (resolve-module (quote (guile))))) +(if #f #f) +(letrec ((and-map*17 (lambda (f57 first56 . rest55) (or (null? first56) (if (null? rest55) (letrec ((andmap58 (lambda (first59) (let ((x60 (car first59)) (first61 (cdr first59))) (if (null? first61) (f57 x60) (and (f57 x60) (andmap58 first61))))))) (andmap58 first56)) (letrec ((andmap62 (lambda (first63 rest64) (let ((x65 (car first63)) (xr66 (map car rest64)) (first67 (cdr first63)) (rest68 (map cdr rest64))) (if (null? first67) (apply f57 (cons x65 xr66)) (and (apply f57 (cons x65 xr66)) (andmap62 first67 rest68))))))) (andmap62 first56 rest55))))))) (letrec ((lambda-var-list160 (lambda (vars289) (letrec ((lvl290 (lambda (vars291 ls292 w293) (cond ((pair? vars291) (lvl290 (cdr vars291) (cons (wrap139 (car vars291) w293 #f) ls292) w293)) ((id?111 vars291) (cons (wrap139 vars291 w293 #f) ls292)) ((null? vars291) ls292) ((syntax-object?95 vars291) (lvl290 (syntax-object-expression96 vars291) ls292 (join-wraps130 w293 (syntax-object-wrap97 vars291)))) ((annotation? vars291) (lvl290 (annotation-expression vars291) ls292 w293)) (else (cons vars291 ls292)))))) (lvl290 vars289 (quote ()) (quote (())))))) (gen-var159 (lambda (id294) (let ((id295 (if (syntax-object?95 id294) (syntax-object-expression96 id294) id294))) (if (annotation? id295) (gensym (symbol->string (annotation-expression id295))) (gensym (symbol->string id295)))))) (strip158 (lambda (x296 w297) (if (memq (quote top) (wrap-marks114 w297)) (if (or (annotation? x296) (and (pair? x296) (annotation? (car x296)))) (strip-annotation157 x296 #f) x296) (letrec ((f298 (lambda (x299) (cond ((syntax-object?95 x299) (strip158 (syntax-object-expression96 x299) (syntax-object-wrap97 x299))) ((pair? x299) (let ((a300 (f298 (car x299))) (d301 (f298 (cdr x299)))) (if (and (eq? a300 (car x299)) (eq? d301 (cdr x299))) x299 (cons a300 d301)))) ((vector? x299) (let ((old302 (vector->list x299))) (let ((new303 (map f298 old302))) (if (and-map*17 eq? old302 new303) x299 (list->vector new303))))) (else x299))))) (f298 x296))))) (strip-annotation157 (lambda (x304 parent305) (cond ((pair? x304) (let ((new306 (cons #f #f))) (begin (if parent305 (set-annotation-stripped! parent305 new306)) (set-car! new306 (strip-annotation157 (car x304) #f)) (set-cdr! new306 (strip-annotation157 (cdr x304) #f)) new306))) ((annotation? x304) (or (annotation-stripped x304) (strip-annotation157 (annotation-expression x304) x304))) ((vector? x304) (let ((new307 (make-vector (vector-length x304)))) (begin (if parent305 (set-annotation-stripped! parent305 new307)) (letrec ((loop308 (lambda (i309) (unless (fx<74 i309 0) (vector-set! new307 i309 (strip-annotation157 (vector-ref x304 i309) #f)) (loop308 (fx-72 i309 1)))))) (loop308 (- (vector-length x304) 1))) new307))) (else x304)))) (ellipsis?156 (lambda (x310) (and (nonsymbol-id?110 x310) (free-id=?134 x310 (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-void155 (lambda () (build-application79 #f (build-primref88 #f (quote if)) (quote (#f #f))))) (eval-local-transformer154 (lambda (expanded311 mod312) (let ((p313 (local-eval-hook76 expanded311 mod312))) (if (procedure? p313) p313 (syntax-violation #f "nonprocedure transformer" p313))))) (chi-local-syntax153 (lambda (rec?314 e315 r316 w317 s318 mod319 k320) ((lambda (tmp321) ((lambda (tmp322) (if tmp322 (apply (lambda (_323 id324 val325 e1326 e2327) (let ((ids328 id324)) (if (not (valid-bound-ids?136 ids328)) (syntax-violation #f "duplicate bound keyword" e315) (let ((labels330 (gen-labels117 ids328))) (let ((new-w331 (make-binding-wrap128 ids328 labels330 w317))) (k320 (cons e1326 e2327) (extend-env105 labels330 (let ((w333 (if rec?314 new-w331 w317)) (trans-r334 (macros-only-env107 r316))) (map (lambda (x335) (cons (quote macro) (eval-local-transformer154 (chi147 x335 trans-r334 w333 mod319) mod319))) val325)) r316) new-w331 s318 mod319)))))) tmp322) ((lambda (_337) (syntax-violation #f "bad local syntax definition" (source-wrap140 e315 w317 s318 mod319))) tmp321))) ($sc-dispatch tmp321 (quote (any #(each (any any)) any . each-any))))) e315))) (chi-lambda-clause152 (lambda (e338 docstring339 c340 r341 w342 mod343 k344) ((lambda (tmp345) ((lambda (tmp346) (if (if tmp346 (apply (lambda (args347 doc348 e1349 e2350) (and (string? (syntax->datum doc348)) (not docstring339))) tmp346) #f) (apply (lambda (args351 doc352 e1353 e2354) (chi-lambda-clause152 e338 doc352 (cons args351 (cons e1353 e2354)) r341 w342 mod343 k344)) tmp346) ((lambda (tmp356) (if tmp356 (apply (lambda (id357 e1358 e2359) (let ((ids360 id357)) (if (not (valid-bound-ids?136 ids360)) (syntax-violation (quote lambda) "invalid parameter list" e338) (let ((labels362 (gen-labels117 ids360)) (new-vars363 (map gen-var159 ids360))) (k344 new-vars363 docstring339 (chi-body151 (cons e1358 e2359) e338 (extend-var-env106 labels362 new-vars363 r341) (make-binding-wrap128 ids360 labels362 w342) mod343)))))) tmp356) ((lambda (tmp365) (if tmp365 (apply (lambda (ids366 e1367 e2368) (let ((old-ids369 (lambda-var-list160 ids366))) (if (not (valid-bound-ids?136 old-ids369)) (syntax-violation (quote lambda) "invalid parameter list" e338) (let ((labels370 (gen-labels117 old-ids369)) (new-vars371 (map gen-var159 old-ids369))) (k344 (letrec ((f372 (lambda (ls1373 ls2374) (if (null? ls1373) ls2374 (f372 (cdr ls1373) (cons (car ls1373) ls2374)))))) (f372 (cdr new-vars371) (car new-vars371))) docstring339 (chi-body151 (cons e1367 e2368) e338 (extend-var-env106 labels370 new-vars371 r341) (make-binding-wrap128 old-ids369 labels370 w342) mod343)))))) tmp365) ((lambda (_376) (syntax-violation (quote lambda) "bad lambda" e338)) tmp345))) ($sc-dispatch tmp345 (quote (any any . each-any)))))) ($sc-dispatch tmp345 (quote (each-any any . each-any)))))) ($sc-dispatch tmp345 (quote (any any any . each-any))))) c340))) (chi-body151 (lambda (body377 outer-form378 r379 w380 mod381) (let ((r382 (cons (quote ("placeholder" placeholder)) r379))) (let ((ribcage383 (make-ribcage118 (quote ()) (quote ()) (quote ())))) (let ((w384 (make-wrap113 (wrap-marks114 w380) (cons ribcage383 (wrap-subst115 w380))))) (letrec ((parse385 (lambda (body386 ids387 labels388 vars389 vals390 bindings391) (if (null? body386) (syntax-violation #f "no expressions in body" outer-form378) (let ((e393 (cdar body386)) (er394 (caar body386))) (call-with-values (lambda () (syntax-type145 e393 er394 (quote (())) #f ribcage383 mod381)) (lambda (type395 value396 e397 w398 s399 mod400) (let ((t401 type395)) (if (memv t401 (quote (define-form))) (let ((id402 (wrap139 value396 w398 mod400)) (label403 (gen-label116))) (let ((var404 (gen-var159 id402))) (begin (extend-ribcage!127 ribcage383 id402 label403) (parse385 (cdr body386) (cons id402 ids387) (cons label403 labels388) (cons var404 vars389) (cons (cons er394 (wrap139 e397 w398 mod400)) vals390) (cons (cons (quote lexical) var404) bindings391))))) (if (memv t401 (quote (define-syntax-form))) (let ((id405 (wrap139 value396 w398 mod400)) (label406 (gen-label116))) (begin (extend-ribcage!127 ribcage383 id405 label406) (parse385 (cdr body386) (cons id405 ids387) (cons label406 labels388) vars389 vals390 (cons (cons (quote macro) (cons er394 (wrap139 e397 w398 mod400))) bindings391)))) (if (memv t401 (quote (begin-form))) ((lambda (tmp407) ((lambda (tmp408) (if tmp408 (apply (lambda (_409 e1410) (parse385 (letrec ((f411 (lambda (forms412) (if (null? forms412) (cdr body386) (cons (cons er394 (wrap139 (car forms412) w398 mod400)) (f411 (cdr forms412))))))) (f411 e1410)) ids387 labels388 vars389 vals390 bindings391)) tmp408) (syntax-violation #f "source expression failed to match any pattern" tmp407))) ($sc-dispatch tmp407 (quote (any . each-any))))) e397) (if (memv t401 (quote (local-syntax-form))) (chi-local-syntax153 value396 e397 er394 w398 s399 mod400 (lambda (forms414 er415 w416 s417 mod418) (parse385 (letrec ((f419 (lambda (forms420) (if (null? forms420) (cdr body386) (cons (cons er415 (wrap139 (car forms420) w416 mod418)) (f419 (cdr forms420))))))) (f419 forms414)) ids387 labels388 vars389 vals390 bindings391))) (if (null? ids387) (build-sequence90 #f (map (lambda (x421) (chi147 (cdr x421) (car x421) (quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400)) (cdr body386)))) (begin (if (not (valid-bound-ids?136 ids387)) (syntax-violation #f "invalid or duplicate identifier in definition" outer-form378)) (letrec ((loop422 (lambda (bs423 er-cache424 r-cache425) (if (not (null? bs423)) (let ((b426 (car bs423))) (if (eq? (car b426) (quote macro)) (let ((er427 (cadr b426))) (let ((r-cache428 (if (eq? er427 er-cache424) r-cache425 (macros-only-env107 er427)))) (begin (set-cdr! b426 (eval-local-transformer154 (chi147 (cddr b426) r-cache428 (quote (())) mod400) mod400)) (loop422 (cdr bs423) er427 r-cache428)))) (loop422 (cdr bs423) er-cache424 r-cache425))))))) (loop422 bindings391 #f #f)) (set-cdr! r382 (extend-env105 labels388 bindings391 (cdr r382))) (build-letrec93 #f vars389 (map (lambda (x429) (chi147 (cdr x429) (car x429) (quote (())) mod400)) vals390) (build-sequence90 #f (map (lambda (x430) (chi147 (cdr x430) (car x430) (quote (())) mod400)) (cons (cons er394 (source-wrap140 e397 w398 s399 mod400)) (cdr body386))))))))))))))))))) (parse385 (map (lambda (x392) (cons r382 (wrap139 x392 w384 mod381))) body377) (quote ()) (quote ()) (quote ()) (quote ()) (quote ())))))))) (chi-macro150 (lambda (p431 e432 r433 w434 rib435 mod436) (letrec ((rebuild-macro-output437 (lambda (x438 m439) (cond ((pair? x438) (cons (rebuild-macro-output437 (car x438) m439) (rebuild-macro-output437 (cdr x438) m439))) ((syntax-object?95 x438) (let ((w440 (syntax-object-wrap97 x438))) (let ((ms441 (wrap-marks114 w440)) (s442 (wrap-subst115 w440))) (if (and (pair? ms441) (eq? (car ms441) #f)) (make-syntax-object94 (syntax-object-expression96 x438) (make-wrap113 (cdr ms441) (if rib435 (cons rib435 (cdr s442)) (cdr s442))) (syntax-object-module98 x438)) (make-syntax-object94 (syntax-object-expression96 x438) (make-wrap113 (cons m439 ms441) (if rib435 (cons rib435 (cons (quote shift) s442)) (cons (quote shift) s442))) (let ((pmod443 (procedure-module p431))) (if pmod443 (cons (quote hygiene) (module-name pmod443)) (quote (hygiene guile))))))))) ((vector? x438) (let ((n444 (vector-length x438))) (let ((v445 (make-vector n444))) (letrec ((doloop446 (lambda (i447) (if (fx=73 i447 n444) v445 (begin (vector-set! v445 i447 (rebuild-macro-output437 (vector-ref x438 i447) m439)) (doloop446 (fx+71 i447 1))))))) (doloop446 0))))) ((symbol? x438) (syntax-violation #f "encountered raw symbol in macro output" (source-wrap140 e432 w434 s mod436) x438)) (else x438))))) (rebuild-macro-output437 (p431 (wrap139 e432 (anti-mark126 w434) mod436)) (string #\m))))) (chi-application149 (lambda (x448 e449 r450 w451 s452 mod453) ((lambda (tmp454) ((lambda (tmp455) (if tmp455 (apply (lambda (e0456 e1457) (build-application79 s452 x448 (map (lambda (e458) (chi147 e458 r450 w451 mod453)) e1457))) tmp455) (syntax-violation #f "source expression failed to match any pattern" tmp454))) ($sc-dispatch tmp454 (quote (any . each-any))))) e449))) (chi-expr148 (lambda (type460 value461 e462 r463 w464 s465 mod466) (let ((t467 type460)) (if (memv t467 (quote (lexical))) (build-lexical-reference81 (quote value) s465 e462 value461) (if (memv t467 (quote (core external-macro))) (value461 e462 r463 w464 s465 mod466) (if (memv t467 (quote (module-ref))) (call-with-values (lambda () (value461 e462)) (lambda (id468 mod469) (build-global-reference84 s465 id468 mod469))) (if (memv t467 (quote (lexical-call))) (chi-application149 (build-lexical-reference81 (quote fun) (source-annotation102 (car e462)) (car e462) value461) e462 r463 w464 s465 mod466) (if (memv t467 (quote (global-call))) (chi-application149 (build-global-reference84 (source-annotation102 (car e462)) value461 (if (syntax-object?95 (car e462)) (syntax-object-module98 (car e462)) mod466)) e462 r463 w464 s465 mod466) (if (memv t467 (quote (constant))) (build-data89 s465 (strip158 (source-wrap140 e462 w464 s465 mod466) (quote (())))) (if (memv t467 (quote (global))) (build-global-reference84 s465 value461 mod466) (if (memv t467 (quote (call))) (chi-application149 (chi147 (car e462) r463 w464 mod466) e462 r463 w464 s465 mod466) (if (memv t467 (quote (begin-form))) ((lambda (tmp470) ((lambda (tmp471) (if tmp471 (apply (lambda (_472 e1473 e2474) (chi-sequence141 (cons e1473 e2474) r463 w464 s465 mod466)) tmp471) (syntax-violation #f "source expression failed to match any pattern" tmp470))) ($sc-dispatch tmp470 (quote (any any . each-any))))) e462) (if (memv t467 (quote (local-syntax-form))) (chi-local-syntax153 value461 e462 r463 w464 s465 mod466 chi-sequence141) (if (memv t467 (quote (eval-when-form))) ((lambda (tmp476) ((lambda (tmp477) (if tmp477 (apply (lambda (_478 x479 e1480 e2481) (let ((when-list482 (chi-when-list144 e462 x479 w464))) (if (memq (quote eval) when-list482) (chi-sequence141 (cons e1480 e2481) r463 w464 s465 mod466) (chi-void155)))) tmp477) (syntax-violation #f "source expression failed to match any pattern" tmp476))) ($sc-dispatch tmp476 (quote (any each-any any . each-any))))) e462) (if (memv t467 (quote (define-form define-syntax-form))) (syntax-violation #f "definition in expression context" e462 (wrap139 value461 w464 mod466)) (if (memv t467 (quote (syntax))) (syntax-violation #f "reference to pattern variable outside syntax form" (source-wrap140 e462 w464 s465 mod466)) (if (memv t467 (quote (displaced-lexical))) (syntax-violation #f "reference to identifier outside its scope" (source-wrap140 e462 w464 s465 mod466)) (syntax-violation #f "unexpected syntax" (source-wrap140 e462 w464 s465 mod466))))))))))))))))))) (chi147 (lambda (e485 r486 w487 mod488) (call-with-values (lambda () (syntax-type145 e485 r486 w487 #f #f mod488)) (lambda (type489 value490 e491 w492 s493 mod494) (chi-expr148 type489 value490 e491 r486 w492 s493 mod494))))) (chi-top146 (lambda (e495 r496 w497 m498 esew499 mod500) (call-with-values (lambda () (syntax-type145 e495 r496 w497 #f #f mod500)) (lambda (type508 value509 e510 w511 s512 mod513) (let ((t514 type508)) (if (memv t514 (quote (begin-form))) ((lambda (tmp515) ((lambda (tmp516) (if tmp516 (apply (lambda (_517) (chi-void155)) tmp516) ((lambda (tmp518) (if tmp518 (apply (lambda (_519 e1520 e2521) (chi-top-sequence142 (cons e1520 e2521) r496 w511 s512 m498 esew499 mod513)) tmp518) (syntax-violation #f "source expression failed to match any pattern" tmp515))) ($sc-dispatch tmp515 (quote (any any . each-any)))))) ($sc-dispatch tmp515 (quote (any))))) e510) (if (memv t514 (quote (local-syntax-form))) (chi-local-syntax153 value509 e510 r496 w511 s512 mod513 (lambda (body523 r524 w525 s526 mod527) (chi-top-sequence142 body523 r524 w525 s526 m498 esew499 mod527))) (if (memv t514 (quote (eval-when-form))) ((lambda (tmp528) ((lambda (tmp529) (if tmp529 (apply (lambda (_530 x531 e1532 e2533) (let ((when-list534 (chi-when-list144 e510 x531 w511)) (body535 (cons e1532 e2533))) (cond ((eq? m498 (quote e)) (if (memq (quote eval) when-list534) (chi-top-sequence142 body535 r496 w511 s512 (quote e) (quote (eval)) mod513) (chi-void155))) ((memq (quote load) when-list534) (if (or (memq (quote compile) when-list534) (and (eq? m498 (quote c&e)) (memq (quote eval) when-list534))) (chi-top-sequence142 body535 r496 w511 s512 (quote c&e) (quote (compile load)) mod513) (if (memq m498 (quote (c c&e))) (chi-top-sequence142 body535 r496 w511 s512 (quote c) (quote (load)) mod513) (chi-void155)))) ((or (memq (quote compile) when-list534) (and (eq? m498 (quote c&e)) (memq (quote eval) when-list534))) (top-level-eval-hook75 (chi-top-sequence142 body535 r496 w511 s512 (quote e) (quote (eval)) mod513) mod513) (chi-void155)) (else (chi-void155))))) tmp529) (syntax-violation #f "source expression failed to match any pattern" tmp528))) ($sc-dispatch tmp528 (quote (any each-any any . each-any))))) e510) (if (memv t514 (quote (define-syntax-form))) (let ((n538 (id-var-name133 value509 w511)) (r539 (macros-only-env107 r496))) (let ((t540 m498)) (if (memv t540 (quote (c))) (if (memq (quote compile) esew499) (let ((e541 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)))) (begin (top-level-eval-hook75 e541 mod513) (if (memq (quote load) esew499) e541 (chi-void155)))) (if (memq (quote load) esew499) (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)) (chi-void155))) (if (memv t540 (quote (c&e))) (let ((e542 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)))) (begin (top-level-eval-hook75 e542 mod513) e542)) (begin (if (memq (quote eval) esew499) (top-level-eval-hook75 (chi-install-global143 n538 (chi147 e510 r539 w511 mod513)) mod513)) (chi-void155)))))) (if (memv t514 (quote (define-form))) (let ((n543 (id-var-name133 value509 w511))) (let ((type544 (binding-type103 (lookup108 n543 r496 mod513)))) (let ((t545 type544)) (if (memv t545 (quote (global core macro module-ref))) (let ((x546 (build-global-definition86 s512 n543 (chi147 e510 r496 w511 mod513)))) (begin (if (eq? m498 (quote c&e)) (top-level-eval-hook75 x546 mod513)) x546)) (if (memv t545 (quote (displaced-lexical))) (syntax-violation #f "identifier out of context" e510 (wrap139 value509 w511 mod513)) (syntax-violation #f "cannot define keyword at top level" e510 (wrap139 value509 w511 mod513))))))) (let ((x547 (chi-expr148 type508 value509 e510 r496 w511 s512 mod513))) (begin (if (eq? m498 (quote c&e)) (top-level-eval-hook75 x547 mod513)) x547)))))))))))) (syntax-type145 (lambda (e548 r549 w550 s551 rib552 mod553) (cond ((symbol? e548) (let ((n554 (id-var-name133 e548 w550))) (let ((b555 (lookup108 n554 r549 mod553))) (let ((type556 (binding-type103 b555))) (let ((t557 type556)) (if (memv t557 (quote (lexical))) (values type556 (binding-value104 b555) e548 w550 s551 mod553) (if (memv t557 (quote (global))) (values type556 n554 e548 w550 s551 mod553) (if (memv t557 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b555) e548 r549 w550 rib552 mod553) r549 (quote (())) s551 rib552 mod553) (values type556 (binding-value104 b555) e548 w550 s551 mod553))))))))) ((pair? e548) (let ((first558 (car e548))) (if (id?111 first558) (let ((n559 (id-var-name133 first558 w550))) (let ((b560 (lookup108 n559 r549 (or (and (syntax-object?95 first558) (syntax-object-module98 first558)) mod553)))) (let ((type561 (binding-type103 b560))) (let ((t562 type561)) (if (memv t562 (quote (lexical))) (values (quote lexical-call) (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (global))) (values (quote global-call) n559 e548 w550 s551 mod553) (if (memv t562 (quote (macro))) (syntax-type145 (chi-macro150 (binding-value104 b560) e548 r549 w550 rib552 mod553) r549 (quote (())) s551 rib552 mod553) (if (memv t562 (quote (core external-macro module-ref))) (values type561 (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (local-syntax))) (values (quote local-syntax-form) (binding-value104 b560) e548 w550 s551 mod553) (if (memv t562 (quote (begin))) (values (quote begin-form) #f e548 w550 s551 mod553) (if (memv t562 (quote (eval-when))) (values (quote eval-when-form) #f e548 w550 s551 mod553) (if (memv t562 (quote (define))) ((lambda (tmp563) ((lambda (tmp564) (if (if tmp564 (apply (lambda (_565 name566 val567) (id?111 name566)) tmp564) #f) (apply (lambda (_568 name569 val570) (values (quote define-form) name569 val570 w550 s551 mod553)) tmp564) ((lambda (tmp571) (if (if tmp571 (apply (lambda (_572 name573 args574 e1575 e2576) (and (id?111 name573) (valid-bound-ids?136 (lambda-var-list160 args574)))) tmp571) #f) (apply (lambda (_577 name578 args579 e1580 e2581) (values (quote define-form) (wrap139 name578 w550 mod553) (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))) (wrap139 (cons args579 (cons e1580 e2581)) w550 mod553)) (quote (())) s551 mod553)) tmp571) ((lambda (tmp583) (if (if tmp583 (apply (lambda (_584 name585) (id?111 name585)) tmp583) #f) (apply (lambda (_586 name587) (values (quote define-form) (wrap139 name587 w550 mod553) (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 (())) s551 mod553)) tmp583) (syntax-violation #f "source expression failed to match any pattern" tmp563))) ($sc-dispatch tmp563 (quote (any any)))))) ($sc-dispatch tmp563 (quote (any (any . any) any . each-any)))))) ($sc-dispatch tmp563 (quote (any any any))))) e548) (if (memv t562 (quote (define-syntax))) ((lambda (tmp588) ((lambda (tmp589) (if (if tmp589 (apply (lambda (_590 name591 val592) (id?111 name591)) tmp589) #f) (apply (lambda (_593 name594 val595) (values (quote define-syntax-form) name594 val595 w550 s551 mod553)) tmp589) (syntax-violation #f "source expression failed to match any pattern" tmp588))) ($sc-dispatch tmp588 (quote (any any any))))) e548) (values (quote call) #f e548 w550 s551 mod553)))))))))))))) (values (quote call) #f e548 w550 s551 mod553)))) ((syntax-object?95 e548) (syntax-type145 (syntax-object-expression96 e548) r549 (join-wraps130 w550 (syntax-object-wrap97 e548)) #f rib552 (or (syntax-object-module98 e548) mod553))) ((annotation? e548) (syntax-type145 (annotation-expression e548) r549 w550 (annotation-source e548) rib552 mod553)) ((self-evaluating? e548) (values (quote constant) #f e548 w550 s551 mod553)) (else (values (quote other) #f e548 w550 s551 mod553))))) (chi-when-list144 (lambda (e596 when-list597 w598) (letrec ((f599 (lambda (when-list600 situations601) (if (null? when-list600) situations601 (f599 (cdr when-list600) (cons (let ((x602 (car when-list600))) (cond ((free-id=?134 x602 (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=?134 x602 (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=?134 x602 (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) "invalid situation" e596 (wrap139 x602 w598 #f))))) situations601)))))) (f599 when-list597 (quote ()))))) (chi-install-global143 (lambda (name603 e604) (build-global-definition86 #f name603 (if (let ((v605 (module-variable (current-module) name603))) (and v605 (variable-bound? v605) (macro? (variable-ref v605)) (not (eq? (macro-type (variable-ref v605)) (quote syncase-macro))))) (build-application79 #f (build-primref88 #f (quote make-extended-syncase-macro)) (list (build-application79 #f (build-primref88 #f (quote module-ref)) (list (build-application79 #f (quote current-module) (quote ())) (build-data89 #f name603))) (build-data89 #f (quote macro)) e604)) (build-application79 #f (build-primref88 #f (quote make-syncase-macro)) (list (build-data89 #f (quote macro)) e604)))))) (chi-top-sequence142 (lambda (body606 r607 w608 s609 m610 esew611 mod612) (build-sequence90 s609 (letrec ((dobody613 (lambda (body614 r615 w616 m617 esew618 mod619) (if (null? body614) (quote ()) (let ((first620 (chi-top146 (car body614) r615 w616 m617 esew618 mod619))) (cons first620 (dobody613 (cdr body614) r615 w616 m617 esew618 mod619))))))) (dobody613 body606 r607 w608 m610 esew611 mod612))))) (chi-sequence141 (lambda (body621 r622 w623 s624 mod625) (build-sequence90 s624 (letrec ((dobody626 (lambda (body627 r628 w629 mod630) (if (null? body627) (quote ()) (let ((first631 (chi147 (car body627) r628 w629 mod630))) (cons first631 (dobody626 (cdr body627) r628 w629 mod630))))))) (dobody626 body621 r622 w623 mod625))))) (source-wrap140 (lambda (x632 w633 s634 defmod635) (wrap139 (if s634 (make-annotation x632 s634 #f) x632) w633 defmod635))) (wrap139 (lambda (x636 w637 defmod638) (cond ((and (null? (wrap-marks114 w637)) (null? (wrap-subst115 w637))) x636) ((syntax-object?95 x636) (make-syntax-object94 (syntax-object-expression96 x636) (join-wraps130 w637 (syntax-object-wrap97 x636)) (syntax-object-module98 x636))) ((null? x636) x636) (else (make-syntax-object94 x636 w637 defmod638))))) (bound-id-member?138 (lambda (x639 list640) (and (not (null? list640)) (or (bound-id=?135 x639 (car list640)) (bound-id-member?138 x639 (cdr list640)))))) (distinct-bound-ids?137 (lambda (ids641) (letrec ((distinct?642 (lambda (ids643) (or (null? ids643) (and (not (bound-id-member?138 (car ids643) (cdr ids643))) (distinct?642 (cdr ids643))))))) (distinct?642 ids641)))) (valid-bound-ids?136 (lambda (ids644) (and (letrec ((all-ids?645 (lambda (ids646) (or (null? ids646) (and (id?111 (car ids646)) (all-ids?645 (cdr ids646))))))) (all-ids?645 ids644)) (distinct-bound-ids?137 ids644)))) (bound-id=?135 (lambda (i647 j648) (if (and (syntax-object?95 i647) (syntax-object?95 j648)) (and (eq? (let ((e649 (syntax-object-expression96 i647))) (if (annotation? e649) (annotation-expression e649) e649)) (let ((e650 (syntax-object-expression96 j648))) (if (annotation? e650) (annotation-expression e650) e650))) (same-marks?132 (wrap-marks114 (syntax-object-wrap97 i647)) (wrap-marks114 (syntax-object-wrap97 j648)))) (eq? (let ((e651 i647)) (if (annotation? e651) (annotation-expression e651) e651)) (let ((e652 j648)) (if (annotation? e652) (annotation-expression e652) e652)))))) (free-id=?134 (lambda (i653 j654) (and (eq? (let ((x655 i653)) (let ((e656 (if (syntax-object?95 x655) (syntax-object-expression96 x655) x655))) (if (annotation? e656) (annotation-expression e656) e656))) (let ((x657 j654)) (let ((e658 (if (syntax-object?95 x657) (syntax-object-expression96 x657) x657))) (if (annotation? e658) (annotation-expression e658) e658)))) (eq? (id-var-name133 i653 (quote (()))) (id-var-name133 j654 (quote (()))))))) (id-var-name133 (lambda (id659 w660) (letrec ((search-vector-rib663 (lambda (sym669 subst670 marks671 symnames672 ribcage673) (let ((n674 (vector-length symnames672))) (letrec ((f675 (lambda (i676) (cond ((fx=73 i676 n674) (search661 sym669 (cdr subst670) marks671)) ((and (eq? (vector-ref symnames672 i676) sym669) (same-marks?132 marks671 (vector-ref (ribcage-marks121 ribcage673) i676))) (values (vector-ref (ribcage-labels122 ribcage673) i676) marks671)) (else (f675 (fx+71 i676 1))))))) (f675 0))))) (search-list-rib662 (lambda (sym677 subst678 marks679 symnames680 ribcage681) (letrec ((f682 (lambda (symnames683 i684) (cond ((null? symnames683) (search661 sym677 (cdr subst678) marks679)) ((and (eq? (car symnames683) sym677) (same-marks?132 marks679 (list-ref (ribcage-marks121 ribcage681) i684))) (values (list-ref (ribcage-labels122 ribcage681) i684) marks679)) (else (f682 (cdr symnames683) (fx+71 i684 1))))))) (f682 symnames680 0)))) (search661 (lambda (sym685 subst686 marks687) (if (null? subst686) (values #f marks687) (let ((fst688 (car subst686))) (if (eq? fst688 (quote shift)) (search661 sym685 (cdr subst686) (cdr marks687)) (let ((symnames689 (ribcage-symnames120 fst688))) (if (vector? symnames689) (search-vector-rib663 sym685 subst686 marks687 symnames689 fst688) (search-list-rib662 sym685 subst686 marks687 symnames689 fst688))))))))) (cond ((symbol? id659) (or (call-with-values (lambda () (search661 id659 (wrap-subst115 w660) (wrap-marks114 w660))) (lambda (x691 . ignore690) x691)) id659)) ((syntax-object?95 id659) (let ((id692 (let ((e694 (syntax-object-expression96 id659))) (if (annotation? e694) (annotation-expression e694) e694))) (w1693 (syntax-object-wrap97 id659))) (let ((marks695 (join-marks131 (wrap-marks114 w660) (wrap-marks114 w1693)))) (call-with-values (lambda () (search661 id692 (wrap-subst115 w660) marks695)) (lambda (new-id696 marks697) (or new-id696 (call-with-values (lambda () (search661 id692 (wrap-subst115 w1693) marks697)) (lambda (x699 . ignore698) x699)) id692)))))) ((annotation? id659) (let ((id700 (let ((e701 id659)) (if (annotation? e701) (annotation-expression e701) e701)))) (or (call-with-values (lambda () (search661 id700 (wrap-subst115 w660) (wrap-marks114 w660))) (lambda (x703 . ignore702) x703)) id700))) (else (syntax-violation (quote id-var-name) "invalid id" id659)))))) (same-marks?132 (lambda (x704 y705) (or (eq? x704 y705) (and (not (null? x704)) (not (null? y705)) (eq? (car x704) (car y705)) (same-marks?132 (cdr x704) (cdr y705)))))) (join-marks131 (lambda (m1706 m2707) (smart-append129 m1706 m2707))) (join-wraps130 (lambda (w1708 w2709) (let ((m1710 (wrap-marks114 w1708)) (s1711 (wrap-subst115 w1708))) (if (null? m1710) (if (null? s1711) w2709 (make-wrap113 (wrap-marks114 w2709) (smart-append129 s1711 (wrap-subst115 w2709)))) (make-wrap113 (smart-append129 m1710 (wrap-marks114 w2709)) (smart-append129 s1711 (wrap-subst115 w2709))))))) (smart-append129 (lambda (m1712 m2713) (if (null? m2713) m1712 (append m1712 m2713)))) (make-binding-wrap128 (lambda (ids714 labels715 w716) (if (null? ids714) w716 (make-wrap113 (wrap-marks114 w716) (cons (let ((labelvec717 (list->vector labels715))) (let ((n718 (vector-length labelvec717))) (let ((symnamevec719 (make-vector n718)) (marksvec720 (make-vector n718))) (begin (letrec ((f721 (lambda (ids722 i723) (if (not (null? ids722)) (call-with-values (lambda () (id-sym-name&marks112 (car ids722) w716)) (lambda (symname724 marks725) (begin (vector-set! symnamevec719 i723 symname724) (vector-set! marksvec720 i723 marks725) (f721 (cdr ids722) (fx+71 i723 1))))))))) (f721 ids714 0)) (make-ribcage118 symnamevec719 marksvec720 labelvec717))))) (wrap-subst115 w716)))))) (extend-ribcage!127 (lambda (ribcage726 id727 label728) (begin (set-ribcage-symnames!123 ribcage726 (cons (let ((e729 (syntax-object-expression96 id727))) (if (annotation? e729) (annotation-expression e729) e729)) (ribcage-symnames120 ribcage726))) (set-ribcage-marks!124 ribcage726 (cons (wrap-marks114 (syntax-object-wrap97 id727)) (ribcage-marks121 ribcage726))) (set-ribcage-labels!125 ribcage726 (cons label728 (ribcage-labels122 ribcage726)))))) (anti-mark126 (lambda (w730) (make-wrap113 (cons #f (wrap-marks114 w730)) (cons (quote shift) (wrap-subst115 w730))))) (set-ribcage-labels!125 (lambda (x731 update732) (vector-set! x731 3 update732))) (set-ribcage-marks!124 (lambda (x733 update734) (vector-set! x733 2 update734))) (set-ribcage-symnames!123 (lambda (x735 update736) (vector-set! x735 1 update736))) (ribcage-labels122 (lambda (x737) (vector-ref x737 3))) (ribcage-marks121 (lambda (x738) (vector-ref x738 2))) (ribcage-symnames120 (lambda (x739) (vector-ref x739 1))) (ribcage?119 (lambda (x740) (and (vector? x740) (= (vector-length x740) 4) (eq? (vector-ref x740 0) (quote ribcage))))) (make-ribcage118 (lambda (symnames741 marks742 labels743) (vector (quote ribcage) symnames741 marks742 labels743))) (gen-labels117 (lambda (ls744) (if (null? ls744) (quote ()) (cons (gen-label116) (gen-labels117 (cdr ls744)))))) (gen-label116 (lambda () (string #\i))) (wrap-subst115 cdr) (wrap-marks114 car) (make-wrap113 cons) (id-sym-name&marks112 (lambda (x745 w746) (if (syntax-object?95 x745) (values (let ((e747 (syntax-object-expression96 x745))) (if (annotation? e747) (annotation-expression e747) e747)) (join-marks131 (wrap-marks114 w746) (wrap-marks114 (syntax-object-wrap97 x745)))) (values (let ((e748 x745)) (if (annotation? e748) (annotation-expression e748) e748)) (wrap-marks114 w746))))) (id?111 (lambda (x749) (cond ((symbol? x749) #t) ((syntax-object?95 x749) (symbol? (let ((e750 (syntax-object-expression96 x749))) (if (annotation? e750) (annotation-expression e750) e750)))) ((annotation? x749) (symbol? (annotation-expression x749))) (else #f)))) (nonsymbol-id?110 (lambda (x751) (and (syntax-object?95 x751) (symbol? (let ((e752 (syntax-object-expression96 x751))) (if (annotation? e752) (annotation-expression e752) e752)))))) (global-extend109 (lambda (type753 sym754 val755) (put-global-definition-hook77 sym754 type753 val755))) (lookup108 (lambda (x756 r757 mod758) (cond ((assq x756 r757) => cdr) ((symbol? x756) (or (get-global-definition-hook78 x756 mod758) (quote (global)))) (else (quote (displaced-lexical)))))) (macros-only-env107 (lambda (r759) (if (null? r759) (quote ()) (let ((a760 (car r759))) (if (eq? (cadr a760) (quote macro)) (cons a760 (macros-only-env107 (cdr r759))) (macros-only-env107 (cdr r759))))))) (extend-var-env106 (lambda (labels761 vars762 r763) (if (null? labels761) r763 (extend-var-env106 (cdr labels761) (cdr vars762) (cons (cons (car labels761) (cons (quote lexical) (car vars762))) r763))))) (extend-env105 (lambda (labels764 bindings765 r766) (if (null? labels764) r766 (extend-env105 (cdr labels764) (cdr bindings765) (cons (cons (car labels764) (car bindings765)) r766))))) (binding-value104 cdr) (binding-type103 car) (source-annotation102 (lambda (x767) (cond ((annotation? x767) (annotation-source x767)) ((syntax-object?95 x767) (source-annotation102 (syntax-object-expression96 x767))) (else #f)))) (set-syntax-object-module!101 (lambda (x768 update769) (vector-set! x768 3 update769))) (set-syntax-object-wrap!100 (lambda (x770 update771) (vector-set! x770 2 update771))) (set-syntax-object-expression!99 (lambda (x772 update773) (vector-set! x772 1 update773))) (syntax-object-module98 (lambda (x774) (vector-ref x774 3))) (syntax-object-wrap97 (lambda (x775) (vector-ref x775 2))) (syntax-object-expression96 (lambda (x776) (vector-ref x776 1))) (syntax-object?95 (lambda (x777) (and (vector? x777) (= (vector-length x777) 4) (eq? (vector-ref x777 0) (quote syntax-object))))) (make-syntax-object94 (lambda (expression778 wrap779 module780) (vector (quote syntax-object) expression778 wrap779 module780))) (build-letrec93 (lambda (src781 vars782 val-exps783 body-exp784) (if (null? vars782) body-exp784 (let ((t785 (fluid-ref *mode*70))) (if (memv t785 (quote (c))) ((@ (language tree-il) make-letrec) src781 vars782 val-exps783 body-exp784) (list (quote letrec) (map list vars782 val-exps783) body-exp784)))))) (build-named-let92 (lambda (src786 vars787 val-exps788 body-exp789) (let ((f790 (car vars787)) (vars791 (cdr vars787))) (let ((t792 (fluid-ref *mode*70))) (if (memv t792 (quote (c))) ((@ (language tree-il) make-letrec) src786 (list f790) (list (build-lambda87 src786 vars791 #f body-exp789)) (build-application79 src786 (build-lexical-reference81 (quote fun) src786 f790 f790) val-exps788)) (list (quote let) f790 (map list vars791 val-exps788) body-exp789)))))) (build-let91 (lambda (src793 vars794 val-exps795 body-exp796) (if (null? vars794) body-exp796 (let ((t797 (fluid-ref *mode*70))) (if (memv t797 (quote (c))) ((@ (language tree-il) make-let) src793 vars794 val-exps795 body-exp796) (list (quote let) (map list vars794 val-exps795) body-exp796)))))) (build-sequence90 (lambda (src798 exps799) (if (null? (cdr exps799)) (car exps799) (let ((t800 (fluid-ref *mode*70))) (if (memv t800 (quote (c))) ((@ (language tree-il) make-sequence) src798 exps799) (cons (quote begin) exps799)))))) (build-data89 (lambda (src801 exp802) (let ((t803 (fluid-ref *mode*70))) (if (memv t803 (quote (c))) ((@ (language tree-il) make-const) src801 exp802) (if (and (self-evaluating? exp802) (not (vector? exp802))) exp802 (list (quote quote) exp802)))))) (build-primref88 (lambda (src804 name805) (let ((t806 (fluid-ref *mode*70))) (if (memv t806 (quote (c))) ((@ (language tree-il) make-primitive-ref) src804 name805) (build-global-reference84 src804 name805 (quote (hygiene guile))))))) (build-lambda87 (lambda (src807 vars808 docstring809 exp810) (let ((t811 (fluid-ref *mode*70))) (if (memv t811 (quote (c))) ((@ (language tree-il) make-lambda) src807 vars808 (if docstring809 (list (cons (quote documentation) docstring809)) (quote ())) exp810) (cons (quote lambda) (cons vars808 (append (if docstring809 (list docstring809) (quote ())) (list exp810)))))))) (build-global-definition86 (lambda (source812 var813 exp814) (let ((t815 (fluid-ref *mode*70))) (if (memv t815 (quote (c))) ((@ (language tree-il) make-toplevel-define) source812 var813 exp814) (list (quote define) var813 exp814))))) (build-global-assignment85 (lambda (source816 var817 exp818 mod819) (analyze-variable83 mod819 var817 (lambda (mod820 var821 public?822) (let ((t823 (fluid-ref *mode*70))) (if (memv t823 (quote (c))) ((@ (language tree-il) make-module-set) source816 mod820 var821 public?822 exp818) (list (quote set!) (list (if public?822 (quote @) (quote @@)) mod820 var821) exp818)))) (lambda (var824) (let ((t825 (fluid-ref *mode*70))) (if (memv t825 (quote (c))) ((@ (language tree-il) make-toplevel-set) source816 var824 exp818) (list (quote set!) var824 exp818))))))) (build-global-reference84 (lambda (source826 var827 mod828) (analyze-variable83 mod828 var827 (lambda (mod829 var830 public?831) (let ((t832 (fluid-ref *mode*70))) (if (memv t832 (quote (c))) ((@ (language tree-il) make-module-ref) source826 mod829 var830 public?831) (list (if public?831 (quote @) (quote @@)) mod829 var830)))) (lambda (var833) (let ((t834 (fluid-ref *mode*70))) (if (memv t834 (quote (c))) ((@ (language tree-il) make-toplevel-ref) source826 var833) var833)))))) (analyze-variable83 (lambda (mod835 var836 modref-cont837 bare-cont838) (if (not mod835) (bare-cont838 var836) (let ((kind839 (car mod835)) (mod840 (cdr mod835))) (let ((t841 kind839)) (if (memv t841 (quote (public))) (modref-cont837 mod840 var836 #t) (if (memv t841 (quote (private))) (if (not (equal? mod840 (module-name (current-module)))) (modref-cont837 mod840 var836 #f) (bare-cont838 var836)) (if (memv t841 (quote (bare))) (bare-cont838 var836) (if (memv t841 (quote (hygiene))) (if (and (not (equal? mod840 (module-name (current-module)))) (module-variable (resolve-module mod840) var836)) (modref-cont837 mod840 var836 #f) (bare-cont838 var836)) (syntax-violation #f "bad module kind" var836 mod840)))))))))) (build-lexical-assignment82 (lambda (source842 name843 var844 exp845) (let ((t846 (fluid-ref *mode*70))) (if (memv t846 (quote (c))) ((@ (language tree-il) make-lexical-set) source842 name843 var844 exp845) (list (quote set!) var844 exp845))))) (build-lexical-reference81 (lambda (type847 source848 name849 var850) (let ((t851 (fluid-ref *mode*70))) (if (memv t851 (quote (c))) ((@ (language tree-il) make-lexical-ref) source848 name849 var850) var850)))) (build-conditional80 (lambda (source852 test-exp853 then-exp854 else-exp855) (let ((t856 (fluid-ref *mode*70))) (if (memv t856 (quote (c))) ((@ (language tree-il) make-conditional) source852 test-exp853 then-exp854 else-exp855) (list (quote if) test-exp853 then-exp854 else-exp855))))) (build-application79 (lambda (source857 fun-exp858 arg-exps859) (let ((t860 (fluid-ref *mode*70))) (if (memv t860 (quote (c))) ((@ (language tree-il) make-application) source857 fun-exp858 arg-exps859) (cons fun-exp858 arg-exps859))))) (get-global-definition-hook78 (lambda (symbol861 module862) (begin (if (and (not module862) (current-module)) (warn "module system is booted, we should have a module" symbol861)) (let ((v863 (module-variable (if module862 (resolve-module (cdr module862)) (current-module)) symbol861))) (and v863 (variable-bound? v863) (let ((val864 (variable-ref v863))) (and (macro? val864) (syncase-macro-type val864) (cons (syncase-macro-type val864) (syncase-macro-binding val864))))))))) (put-global-definition-hook77 (lambda (symbol865 type866 val867) (let ((existing868 (let ((v869 (module-variable (current-module) symbol865))) (and v869 (variable-bound? v869) (let ((val870 (variable-ref v869))) (and (macro? val870) (not (syncase-macro-type val870)) val870)))))) (module-define! (current-module) symbol865 (if existing868 (make-extended-syncase-macro existing868 type866 val867) (make-syncase-macro type866 val867)))))) (local-eval-hook76 (lambda (x871 mod872) (primitive-eval (list noexpand69 (let ((t873 (fluid-ref *mode*70))) (if (memv t873 (quote (c))) ((@ (language tree-il) tree-il->scheme) x871) x871)))))) (top-level-eval-hook75 (lambda (x874 mod875) (primitive-eval (list noexpand69 (let ((t876 (fluid-ref *mode*70))) (if (memv t876 (quote (c))) ((@ (language tree-il) tree-il->scheme) x874) x874)))))) (fx<74 <) (fx=73 =) (fx-72 -) (fx+71 +) (*mode*70 (make-fluid)) (noexpand69 "noexpand")) (begin (global-extend109 (quote local-syntax) (quote letrec-syntax) #t) (global-extend109 (quote local-syntax) (quote let-syntax) #f) (global-extend109 (quote core) (quote fluid-let-syntax) (lambda (e877 r878 w879 s880 mod881) ((lambda (tmp882) ((lambda (tmp883) (if (if tmp883 (apply (lambda (_884 var885 val886 e1887 e2888) (valid-bound-ids?136 var885)) tmp883) #f) (apply (lambda (_890 var891 val892 e1893 e2894) (let ((names895 (map (lambda (x896) (id-var-name133 x896 w879)) var891))) (begin (for-each (lambda (id898 n899) (let ((t900 (binding-type103 (lookup108 n899 r878 mod881)))) (if (memv t900 (quote (displaced-lexical))) (syntax-violation (quote fluid-let-syntax) "identifier out of context" e877 (source-wrap140 id898 w879 s880 mod881))))) var891 names895) (chi-body151 (cons e1893 e2894) (source-wrap140 e877 w879 s880 mod881) (extend-env105 names895 (let ((trans-r903 (macros-only-env107 r878))) (map (lambda (x904) (cons (quote macro) (eval-local-transformer154 (chi147 x904 trans-r903 w879 mod881) mod881))) val892)) r878) w879 mod881)))) tmp883) ((lambda (_906) (syntax-violation (quote fluid-let-syntax) "bad syntax" (source-wrap140 e877 w879 s880 mod881))) tmp882))) ($sc-dispatch tmp882 (quote (any #(each (any any)) any . each-any))))) e877))) (global-extend109 (quote core) (quote quote) (lambda (e907 r908 w909 s910 mod911) ((lambda (tmp912) ((lambda (tmp913) (if tmp913 (apply (lambda (_914 e915) (build-data89 s910 (strip158 e915 w909))) tmp913) ((lambda (_916) (syntax-violation (quote quote) "bad syntax" (source-wrap140 e907 w909 s910 mod911))) tmp912))) ($sc-dispatch tmp912 (quote (any any))))) e907))) (global-extend109 (quote core) (quote syntax) (letrec ((regen924 (lambda (x925) (let ((t926 (car x925))) (if (memv t926 (quote (ref))) (build-lexical-reference81 (quote value) #f (cadr x925) (cadr x925)) (if (memv t926 (quote (primitive))) (build-primref88 #f (cadr x925)) (if (memv t926 (quote (quote))) (build-data89 #f (cadr x925)) (if (memv t926 (quote (lambda))) (build-lambda87 #f (cadr x925) #f (regen924 (caddr x925))) (if (memv t926 (quote (map))) (let ((ls927 (map regen924 (cdr x925)))) (build-application79 #f (build-primref88 #f (quote map)) ls927)) (build-application79 #f (build-primref88 #f (car x925)) (map regen924 (cdr x925))))))))))) (gen-vector923 (lambda (x928) (cond ((eq? (car x928) (quote list)) (cons (quote vector) (cdr x928))) ((eq? (car x928) (quote quote)) (list (quote quote) (list->vector (cadr x928)))) (else (list (quote list->vector) x928))))) (gen-append922 (lambda (x929 y930) (if (equal? y930 (quote (quote ()))) x929 (list (quote append) x929 y930)))) (gen-cons921 (lambda (x931 y932) (let ((t933 (car y932))) (if (memv t933 (quote (quote))) (if (eq? (car x931) (quote quote)) (list (quote quote) (cons (cadr x931) (cadr y932))) (if (eq? (cadr y932) (quote ())) (list (quote list) x931) (list (quote cons) x931 y932))) (if (memv t933 (quote (list))) (cons (quote list) (cons x931 (cdr y932))) (list (quote cons) x931 y932)))))) (gen-map920 (lambda (e934 map-env935) (let ((formals936 (map cdr map-env935)) (actuals937 (map (lambda (x938) (list (quote ref) (car x938))) map-env935))) (cond ((eq? (car e934) (quote ref)) (car actuals937)) ((and-map (lambda (x939) (and (eq? (car x939) (quote ref)) (memq (cadr x939) formals936))) (cdr e934)) (cons (quote map) (cons (list (quote primitive) (car e934)) (map (let ((r940 (map cons formals936 actuals937))) (lambda (x941) (cdr (assq (cadr x941) r940)))) (cdr e934))))) (else (cons (quote map) (cons (list (quote lambda) formals936 e934) actuals937))))))) (gen-mappend919 (lambda (e942 map-env943) (list (quote apply) (quote (primitive append)) (gen-map920 e942 map-env943)))) (gen-ref918 (lambda (src944 var945 level946 maps947) (if (fx=73 level946 0) (values var945 maps947) (if (null? maps947) (syntax-violation (quote syntax) "missing ellipsis" src944) (call-with-values (lambda () (gen-ref918 src944 var945 (fx-72 level946 1) (cdr maps947))) (lambda (outer-var948 outer-maps949) (let ((b950 (assq outer-var948 (car maps947)))) (if b950 (values (cdr b950) maps947) (let ((inner-var951 (gen-var159 (quote tmp)))) (values inner-var951 (cons (cons (cons outer-var948 inner-var951) (car maps947)) outer-maps949))))))))))) (gen-syntax917 (lambda (src952 e953 r954 maps955 ellipsis?956 mod957) (if (id?111 e953) (let ((label958 (id-var-name133 e953 (quote (()))))) (let ((b959 (lookup108 label958 r954 mod957))) (if (eq? (binding-type103 b959) (quote syntax)) (call-with-values (lambda () (let ((var.lev960 (binding-value104 b959))) (gen-ref918 src952 (car var.lev960) (cdr var.lev960) maps955))) (lambda (var961 maps962) (values (list (quote ref) var961) maps962))) (if (ellipsis?956 e953) (syntax-violation (quote syntax) "misplaced ellipsis" src952) (values (list (quote quote) e953) maps955))))) ((lambda (tmp963) ((lambda (tmp964) (if (if tmp964 (apply (lambda (dots965 e966) (ellipsis?956 dots965)) tmp964) #f) (apply (lambda (dots967 e968) (gen-syntax917 src952 e968 r954 maps955 (lambda (x969) #f) mod957)) tmp964) ((lambda (tmp970) (if (if tmp970 (apply (lambda (x971 dots972 y973) (ellipsis?956 dots972)) tmp970) #f) (apply (lambda (x974 dots975 y976) (letrec ((f977 (lambda (y978 k979) ((lambda (tmp983) ((lambda (tmp984) (if (if tmp984 (apply (lambda (dots985 y986) (ellipsis?956 dots985)) tmp984) #f) (apply (lambda (dots987 y988) (f977 y988 (lambda (maps989) (call-with-values (lambda () (k979 (cons (quote ()) maps989))) (lambda (x990 maps991) (if (null? (car maps991)) (syntax-violation (quote syntax) "extra ellipsis" src952) (values (gen-mappend919 x990 (car maps991)) (cdr maps991)))))))) tmp984) ((lambda (_992) (call-with-values (lambda () (gen-syntax917 src952 y978 r954 maps955 ellipsis?956 mod957)) (lambda (y993 maps994) (call-with-values (lambda () (k979 maps994)) (lambda (x995 maps996) (values (gen-append922 x995 y993) maps996)))))) tmp983))) ($sc-dispatch tmp983 (quote (any . any))))) y978)))) (f977 y976 (lambda (maps980) (call-with-values (lambda () (gen-syntax917 src952 x974 r954 (cons (quote ()) maps980) ellipsis?956 mod957)) (lambda (x981 maps982) (if (null? (car maps982)) (syntax-violation (quote syntax) "extra ellipsis" src952) (values (gen-map920 x981 (car maps982)) (cdr maps982))))))))) tmp970) ((lambda (tmp997) (if tmp997 (apply (lambda (x998 y999) (call-with-values (lambda () (gen-syntax917 src952 x998 r954 maps955 ellipsis?956 mod957)) (lambda (x1000 maps1001) (call-with-values (lambda () (gen-syntax917 src952 y999 r954 maps1001 ellipsis?956 mod957)) (lambda (y1002 maps1003) (values (gen-cons921 x1000 y1002) maps1003)))))) tmp997) ((lambda (tmp1004) (if tmp1004 (apply (lambda (e11005 e21006) (call-with-values (lambda () (gen-syntax917 src952 (cons e11005 e21006) r954 maps955 ellipsis?956 mod957)) (lambda (e1008 maps1009) (values (gen-vector923 e1008) maps1009)))) tmp1004) ((lambda (_1010) (values (list (quote quote) e953) maps955)) tmp963))) ($sc-dispatch tmp963 (quote #(vector (any . each-any))))))) ($sc-dispatch tmp963 (quote (any . any)))))) ($sc-dispatch tmp963 (quote (any any . any)))))) ($sc-dispatch tmp963 (quote (any any))))) e953))))) (lambda (e1011 r1012 w1013 s1014 mod1015) (let ((e1016 (source-wrap140 e1011 w1013 s1014 mod1015))) ((lambda (tmp1017) ((lambda (tmp1018) (if tmp1018 (apply (lambda (_1019 x1020) (call-with-values (lambda () (gen-syntax917 e1016 x1020 r1012 (quote ()) ellipsis?156 mod1015)) (lambda (e1021 maps1022) (regen924 e1021)))) tmp1018) ((lambda (_1023) (syntax-violation (quote syntax) "bad `syntax' form" e1016)) tmp1017))) ($sc-dispatch tmp1017 (quote (any any))))) e1016))))) (global-extend109 (quote core) (quote lambda) (lambda (e1024 r1025 w1026 s1027 mod1028) ((lambda (tmp1029) ((lambda (tmp1030) (if tmp1030 (apply (lambda (_1031 c1032) (chi-lambda-clause152 (source-wrap140 e1024 w1026 s1027 mod1028) #f c1032 r1025 w1026 mod1028 (lambda (vars1033 docstring1034 body1035) (build-lambda87 s1027 vars1033 docstring1034 body1035)))) tmp1030) (syntax-violation #f "source expression failed to match any pattern" tmp1029))) ($sc-dispatch tmp1029 (quote (any . any))))) e1024))) (global-extend109 (quote core) (quote let) (letrec ((chi-let1036 (lambda (e1037 r1038 w1039 s1040 mod1041 constructor1042 ids1043 vals1044 exps1045) (if (not (valid-bound-ids?136 ids1043)) (syntax-violation (quote let) "duplicate bound variable" e1037) (let ((labels1046 (gen-labels117 ids1043)) (new-vars1047 (map gen-var159 ids1043))) (let ((nw1048 (make-binding-wrap128 ids1043 labels1046 w1039)) (nr1049 (extend-var-env106 labels1046 new-vars1047 r1038))) (constructor1042 s1040 new-vars1047 (map (lambda (x1050) (chi147 x1050 r1038 w1039 mod1041)) vals1044) (chi-body151 exps1045 (source-wrap140 e1037 nw1048 s1040 mod1041) nr1049 nw1048 mod1041)))))))) (lambda (e1051 r1052 w1053 s1054 mod1055) ((lambda (tmp1056) ((lambda (tmp1057) (if tmp1057 (apply (lambda (_1058 id1059 val1060 e11061 e21062) (chi-let1036 e1051 r1052 w1053 s1054 mod1055 build-let91 id1059 val1060 (cons e11061 e21062))) tmp1057) ((lambda (tmp1066) (if (if tmp1066 (apply (lambda (_1067 f1068 id1069 val1070 e11071 e21072) (id?111 f1068)) tmp1066) #f) (apply (lambda (_1073 f1074 id1075 val1076 e11077 e21078) (chi-let1036 e1051 r1052 w1053 s1054 mod1055 build-named-let92 (cons f1074 id1075) val1076 (cons e11077 e21078))) tmp1066) ((lambda (_1082) (syntax-violation (quote let) "bad let" (source-wrap140 e1051 w1053 s1054 mod1055))) tmp1056))) ($sc-dispatch tmp1056 (quote (any any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1056 (quote (any #(each (any any)) any . each-any))))) e1051)))) (global-extend109 (quote core) (quote letrec) (lambda (e1083 r1084 w1085 s1086 mod1087) ((lambda (tmp1088) ((lambda (tmp1089) (if tmp1089 (apply (lambda (_1090 id1091 val1092 e11093 e21094) (let ((ids1095 id1091)) (if (not (valid-bound-ids?136 ids1095)) (syntax-violation (quote letrec) "duplicate bound variable" e1083) (let ((labels1097 (gen-labels117 ids1095)) (new-vars1098 (map gen-var159 ids1095))) (let ((w1099 (make-binding-wrap128 ids1095 labels1097 w1085)) (r1100 (extend-var-env106 labels1097 new-vars1098 r1084))) (build-letrec93 s1086 new-vars1098 (map (lambda (x1101) (chi147 x1101 r1100 w1099 mod1087)) val1092) (chi-body151 (cons e11093 e21094) (source-wrap140 e1083 w1099 s1086 mod1087) r1100 w1099 mod1087))))))) tmp1089) ((lambda (_1104) (syntax-violation (quote letrec) "bad letrec" (source-wrap140 e1083 w1085 s1086 mod1087))) tmp1088))) ($sc-dispatch tmp1088 (quote (any #(each (any any)) any . each-any))))) e1083))) (global-extend109 (quote core) (quote set!) (lambda (e1105 r1106 w1107 s1108 mod1109) ((lambda (tmp1110) ((lambda (tmp1111) (if (if tmp1111 (apply (lambda (_1112 id1113 val1114) (id?111 id1113)) tmp1111) #f) (apply (lambda (_1115 id1116 val1117) (let ((val1118 (chi147 val1117 r1106 w1107 mod1109)) (n1119 (id-var-name133 id1116 w1107))) (let ((b1120 (lookup108 n1119 r1106 mod1109))) (let ((t1121 (binding-type103 b1120))) (if (memv t1121 (quote (lexical))) (build-lexical-assignment82 s1108 (syntax->datum id1116) (binding-value104 b1120) val1118) (if (memv t1121 (quote (global))) (build-global-assignment85 s1108 n1119 val1118 mod1109) (if (memv t1121 (quote (displaced-lexical))) (syntax-violation (quote set!) "identifier out of context" (wrap139 id1116 w1107 mod1109)) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1105 w1107 s1108 mod1109))))))))) tmp1111) ((lambda (tmp1122) (if tmp1122 (apply (lambda (_1123 head1124 tail1125 val1126) (call-with-values (lambda () (syntax-type145 head1124 r1106 (quote (())) #f #f mod1109)) (lambda (type1127 value1128 ee1129 ww1130 ss1131 modmod1132) (let ((t1133 type1127)) (if (memv t1133 (quote (module-ref))) (let ((val1134 (chi147 val1126 r1106 w1107 mod1109))) (call-with-values (lambda () (value1128 (cons head1124 tail1125))) (lambda (id1136 mod1137) (build-global-assignment85 s1108 id1136 val1134 mod1137)))) (build-application79 s1108 (chi147 (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))) head1124) r1106 w1107 mod1109) (map (lambda (e1138) (chi147 e1138 r1106 w1107 mod1109)) (append tail1125 (list val1126))))))))) tmp1122) ((lambda (_1140) (syntax-violation (quote set!) "bad set!" (source-wrap140 e1105 w1107 s1108 mod1109))) tmp1110))) ($sc-dispatch tmp1110 (quote (any (any . each-any) any)))))) ($sc-dispatch tmp1110 (quote (any any any))))) e1105))) (global-extend109 (quote module-ref) (quote @) (lambda (e1141) ((lambda (tmp1142) ((lambda (tmp1143) (if (if tmp1143 (apply (lambda (_1144 mod1145 id1146) (and (and-map id?111 mod1145) (id?111 id1146))) tmp1143) #f) (apply (lambda (_1148 mod1149 id1150) (values (syntax->datum id1150) (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))) mod1149)))) tmp1143) (syntax-violation #f "source expression failed to match any pattern" tmp1142))) ($sc-dispatch tmp1142 (quote (any each-any any))))) e1141))) (global-extend109 (quote module-ref) (quote @@) (lambda (e1152) ((lambda (tmp1153) ((lambda (tmp1154) (if (if tmp1154 (apply (lambda (_1155 mod1156 id1157) (and (and-map id?111 mod1156) (id?111 id1157))) tmp1154) #f) (apply (lambda (_1159 mod1160 id1161) (values (syntax->datum id1161) (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))) mod1160)))) tmp1154) (syntax-violation #f "source expression failed to match any pattern" tmp1153))) ($sc-dispatch tmp1153 (quote (any each-any any))))) e1152))) (global-extend109 (quote begin) (quote begin) (quote ())) (global-extend109 (quote define) (quote define) (quote ())) (global-extend109 (quote define-syntax) (quote define-syntax) (quote ())) (global-extend109 (quote eval-when) (quote eval-when) (quote ())) (global-extend109 (quote core) (quote syntax-case) (letrec ((gen-syntax-case1166 (lambda (x1167 keys1168 clauses1169 r1170 mod1171) (if (null? clauses1169) (build-application79 #f (build-primref88 #f (quote syntax-violation)) (list #f "source expression failed to match any pattern" x1167)) ((lambda (tmp1172) ((lambda (tmp1173) (if tmp1173 (apply (lambda (pat1174 exp1175) (if (and (id?111 pat1174) (and-map (lambda (x1176) (not (free-id=?134 pat1174 x1176))) (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))) keys1168))) (let ((labels1177 (list (gen-label116))) (var1178 (gen-var159 pat1174))) (build-application79 #f (build-lambda87 #f (list var1178) #f (chi147 exp1175 (extend-env105 labels1177 (list (cons (quote syntax) (cons var1178 0))) r1170) (make-binding-wrap128 (list pat1174) labels1177 (quote (()))) mod1171)) (list x1167))) (gen-clause1165 x1167 keys1168 (cdr clauses1169) r1170 pat1174 #t exp1175 mod1171))) tmp1173) ((lambda (tmp1179) (if tmp1179 (apply (lambda (pat1180 fender1181 exp1182) (gen-clause1165 x1167 keys1168 (cdr clauses1169) r1170 pat1180 fender1181 exp1182 mod1171)) tmp1179) ((lambda (_1183) (syntax-violation (quote syntax-case) "invalid clause" (car clauses1169))) tmp1172))) ($sc-dispatch tmp1172 (quote (any any any)))))) ($sc-dispatch tmp1172 (quote (any any))))) (car clauses1169))))) (gen-clause1165 (lambda (x1184 keys1185 clauses1186 r1187 pat1188 fender1189 exp1190 mod1191) (call-with-values (lambda () (convert-pattern1163 pat1188 keys1185)) (lambda (p1192 pvars1193) (cond ((not (distinct-bound-ids?137 (map car pvars1193))) (syntax-violation (quote syntax-case) "duplicate pattern variable" pat1188)) ((not (and-map (lambda (x1194) (not (ellipsis?156 (car x1194)))) pvars1193)) (syntax-violation (quote syntax-case) "misplaced ellipsis" pat1188)) (else (let ((y1195 (gen-var159 (quote tmp)))) (build-application79 #f (build-lambda87 #f (list y1195) #f (let ((y1196 (build-lexical-reference81 (quote value) #f (quote tmp) y1195))) (build-conditional80 #f ((lambda (tmp1197) ((lambda (tmp1198) (if tmp1198 (apply (lambda () y1196) tmp1198) ((lambda (_1199) (build-conditional80 #f y1196 (build-dispatch-call1164 pvars1193 fender1189 y1196 r1187 mod1191) (build-data89 #f #f))) tmp1197))) ($sc-dispatch tmp1197 (quote #(atom #t))))) fender1189) (build-dispatch-call1164 pvars1193 exp1190 y1196 r1187 mod1191) (gen-syntax-case1166 x1184 keys1185 clauses1186 r1187 mod1191)))) (list (if (eq? p1192 (quote any)) (build-application79 #f (build-primref88 #f (quote list)) (list x1184)) (build-application79 #f (build-primref88 #f (quote $sc-dispatch)) (list x1184 (build-data89 #f p1192))))))))))))) (build-dispatch-call1164 (lambda (pvars1200 exp1201 y1202 r1203 mod1204) (let ((ids1205 (map car pvars1200)) (levels1206 (map cdr pvars1200))) (let ((labels1207 (gen-labels117 ids1205)) (new-vars1208 (map gen-var159 ids1205))) (build-application79 #f (build-primref88 #f (quote apply)) (list (build-lambda87 #f new-vars1208 #f (chi147 exp1201 (extend-env105 labels1207 (map (lambda (var1209 level1210) (cons (quote syntax) (cons var1209 level1210))) new-vars1208 (map cdr pvars1200)) r1203) (make-binding-wrap128 ids1205 labels1207 (quote (()))) mod1204)) y1202)))))) (convert-pattern1163 (lambda (pattern1211 keys1212) (letrec ((cvt1213 (lambda (p1214 n1215 ids1216) (if (id?111 p1214) (if (bound-id-member?138 p1214 keys1212) (values (vector (quote free-id) p1214) ids1216) (values (quote any) (cons (cons p1214 n1215) ids1216))) ((lambda (tmp1217) ((lambda (tmp1218) (if (if tmp1218 (apply (lambda (x1219 dots1220) (ellipsis?156 dots1220)) tmp1218) #f) (apply (lambda (x1221 dots1222) (call-with-values (lambda () (cvt1213 x1221 (fx+71 n1215 1) ids1216)) (lambda (p1223 ids1224) (values (if (eq? p1223 (quote any)) (quote each-any) (vector (quote each) p1223)) ids1224)))) tmp1218) ((lambda (tmp1225) (if tmp1225 (apply (lambda (x1226 y1227) (call-with-values (lambda () (cvt1213 y1227 n1215 ids1216)) (lambda (y1228 ids1229) (call-with-values (lambda () (cvt1213 x1226 n1215 ids1229)) (lambda (x1230 ids1231) (values (cons x1230 y1228) ids1231)))))) tmp1225) ((lambda (tmp1232) (if tmp1232 (apply (lambda () (values (quote ()) ids1216)) tmp1232) ((lambda (tmp1233) (if tmp1233 (apply (lambda (x1234) (call-with-values (lambda () (cvt1213 x1234 n1215 ids1216)) (lambda (p1236 ids1237) (values (vector (quote vector) p1236) ids1237)))) tmp1233) ((lambda (x1238) (values (vector (quote atom) (strip158 p1214 (quote (())))) ids1216)) tmp1217))) ($sc-dispatch tmp1217 (quote #(vector each-any)))))) ($sc-dispatch tmp1217 (quote ()))))) ($sc-dispatch tmp1217 (quote (any . any)))))) ($sc-dispatch tmp1217 (quote (any any))))) p1214))))) (cvt1213 pattern1211 0 (quote ())))))) (lambda (e1239 r1240 w1241 s1242 mod1243) (let ((e1244 (source-wrap140 e1239 w1241 s1242 mod1243))) ((lambda (tmp1245) ((lambda (tmp1246) (if tmp1246 (apply (lambda (_1247 val1248 key1249 m1250) (if (and-map (lambda (x1251) (and (id?111 x1251) (not (ellipsis?156 x1251)))) key1249) (let ((x1253 (gen-var159 (quote tmp)))) (build-application79 s1242 (build-lambda87 #f (list x1253) #f (gen-syntax-case1166 (build-lexical-reference81 (quote value) #f (quote tmp) x1253) key1249 m1250 r1240 mod1243)) (list (chi147 val1248 r1240 (quote (())) mod1243)))) (syntax-violation (quote syntax-case) "invalid literals list" e1244))) tmp1246) (syntax-violation #f "source expression failed to match any pattern" tmp1245))) ($sc-dispatch tmp1245 (quote (any any each-any . each-any))))) e1244))))) (set! sc-expand (lambda (x1257 . rest1256) (if (and (pair? x1257) (equal? (car x1257) noexpand69)) (cadr x1257) (let ((m1258 (if (null? rest1256) (quote e) (car rest1256))) (esew1259 (if (or (null? rest1256) (null? (cdr rest1256))) (quote (eval)) (cadr rest1256)))) (with-fluid* *mode*70 m1258 (lambda () (chi-top146 x1257 (quote ()) (quote ((top))) m1258 esew1259 (cons (quote hygiene) (module-name (current-module)))))))))) (set! identifier? (lambda (x1260) (nonsymbol-id?110 x1260))) (set! datum->syntax (lambda (id1261 datum1262) (make-syntax-object94 datum1262 (syntax-object-wrap97 id1261) #f))) (set! syntax->datum (lambda (x1263) (strip158 x1263 (quote (()))))) (set! generate-temporaries (lambda (ls1264) (begin (let ((x1265 ls1264)) (if (not (list? x1265)) (syntax-violation (quote generate-temporaries) "invalid argument" x1265))) (map (lambda (x1266) (wrap139 (gensym) (quote ((top))) #f)) ls1264)))) (set! free-identifier=? (lambda (x1267 y1268) (begin (let ((x1269 x1267)) (if (not (nonsymbol-id?110 x1269)) (syntax-violation (quote free-identifier=?) "invalid argument" x1269))) (let ((x1270 y1268)) (if (not (nonsymbol-id?110 x1270)) (syntax-violation (quote free-identifier=?) "invalid argument" x1270))) (free-id=?134 x1267 y1268)))) (set! bound-identifier=? (lambda (x1271 y1272) (begin (let ((x1273 x1271)) (if (not (nonsymbol-id?110 x1273)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1273))) (let ((x1274 y1272)) (if (not (nonsymbol-id?110 x1274)) (syntax-violation (quote bound-identifier=?) "invalid argument" x1274))) (bound-id=?135 x1271 y1272)))) (set! syntax-violation (lambda (who1278 message1277 form1276 . subform1275) (begin (let ((x1279 who1278)) (if (not ((lambda (x1280) (or (not x1280) (string? x1280) (symbol? x1280))) x1279)) (syntax-violation (quote syntax-violation) "invalid argument" x1279))) (let ((x1281 message1277)) (if (not (string? x1281)) (syntax-violation (quote syntax-violation) "invalid argument" x1281))) (scm-error (quote syntax-error) (quote sc-expand) (string-append (if who1278 "~a: " "") "~a " (if (null? subform1275) "in ~a" "in subform `~s' of `~s'")) (let ((tail1282 (cons message1277 (map (lambda (x1283) (strip158 x1283 (quote (())))) (append subform1275 (list form1276)))))) (if who1278 (cons who1278 tail1282) tail1282)) #f)))) (letrec ((match1288 (lambda (e1289 p1290 w1291 r1292 mod1293) (cond ((not r1292) #f) ((eq? p1290 (quote any)) (cons (wrap139 e1289 w1291 mod1293) r1292)) ((syntax-object?95 e1289) (match*1287 (let ((e1294 (syntax-object-expression96 e1289))) (if (annotation? e1294) (annotation-expression e1294) e1294)) p1290 (join-wraps130 w1291 (syntax-object-wrap97 e1289)) r1292 (syntax-object-module98 e1289))) (else (match*1287 (let ((e1295 e1289)) (if (annotation? e1295) (annotation-expression e1295) e1295)) p1290 w1291 r1292 mod1293))))) (match*1287 (lambda (e1296 p1297 w1298 r1299 mod1300) (cond ((null? p1297) (and (null? e1296) r1299)) ((pair? p1297) (and (pair? e1296) (match1288 (car e1296) (car p1297) w1298 (match1288 (cdr e1296) (cdr p1297) w1298 r1299 mod1300) mod1300))) ((eq? p1297 (quote each-any)) (let ((l1301 (match-each-any1285 e1296 w1298 mod1300))) (and l1301 (cons l1301 r1299)))) (else (let ((t1302 (vector-ref p1297 0))) (if (memv t1302 (quote (each))) (if (null? e1296) (match-empty1286 (vector-ref p1297 1) r1299) (let ((l1303 (match-each1284 e1296 (vector-ref p1297 1) w1298 mod1300))) (and l1303 (letrec ((collect1304 (lambda (l1305) (if (null? (car l1305)) r1299 (cons (map car l1305) (collect1304 (map cdr l1305))))))) (collect1304 l1303))))) (if (memv t1302 (quote (free-id))) (and (id?111 e1296) (free-id=?134 (wrap139 e1296 w1298 mod1300) (vector-ref p1297 1)) r1299) (if (memv t1302 (quote (atom))) (and (equal? (vector-ref p1297 1) (strip158 e1296 w1298)) r1299) (if (memv t1302 (quote (vector))) (and (vector? e1296) (match1288 (vector->list e1296) (vector-ref p1297 1) w1298 r1299 mod1300))))))))))) (match-empty1286 (lambda (p1306 r1307) (cond ((null? p1306) r1307) ((eq? p1306 (quote any)) (cons (quote ()) r1307)) ((pair? p1306) (match-empty1286 (car p1306) (match-empty1286 (cdr p1306) r1307))) ((eq? p1306 (quote each-any)) (cons (quote ()) r1307)) (else (let ((t1308 (vector-ref p1306 0))) (if (memv t1308 (quote (each))) (match-empty1286 (vector-ref p1306 1) r1307) (if (memv t1308 (quote (free-id atom))) r1307 (if (memv t1308 (quote (vector))) (match-empty1286 (vector-ref p1306 1) r1307))))))))) (match-each-any1285 (lambda (e1309 w1310 mod1311) (cond ((annotation? e1309) (match-each-any1285 (annotation-expression e1309) w1310 mod1311)) ((pair? e1309) (let ((l1312 (match-each-any1285 (cdr e1309) w1310 mod1311))) (and l1312 (cons (wrap139 (car e1309) w1310 mod1311) l1312)))) ((null? e1309) (quote ())) ((syntax-object?95 e1309) (match-each-any1285 (syntax-object-expression96 e1309) (join-wraps130 w1310 (syntax-object-wrap97 e1309)) mod1311)) (else #f)))) (match-each1284 (lambda (e1313 p1314 w1315 mod1316) (cond ((annotation? e1313) (match-each1284 (annotation-expression e1313) p1314 w1315 mod1316)) ((pair? e1313) (let ((first1317 (match1288 (car e1313) p1314 w1315 (quote ()) mod1316))) (and first1317 (let ((rest1318 (match-each1284 (cdr e1313) p1314 w1315 mod1316))) (and rest1318 (cons first1317 rest1318)))))) ((null? e1313) (quote ())) ((syntax-object?95 e1313) (match-each1284 (syntax-object-expression96 e1313) p1314 (join-wraps130 w1315 (syntax-object-wrap97 e1313)) (syntax-object-module98 e1313))) (else #f))))) (set! $sc-dispatch (lambda (e1319 p1320) (cond ((eq? p1320 (quote any)) (list e1319)) ((syntax-object?95 e1319) (match*1287 (let ((e1321 (syntax-object-expression96 e1319))) (if (annotation? e1321) (annotation-expression e1321) e1321)) p1320 (syntax-object-wrap97 e1319) (quote ()) (syntax-object-module98 e1319))) (else (match*1287 (let ((e1322 e1319)) (if (annotation? e1322) (annotation-expression e1322) e1322)) p1320 (quote (())) (quote ()) #f))))))))) +(define with-syntax (make-syncase-macro (quote macro) (lambda (x1323) ((lambda (tmp1324) ((lambda (tmp1325) (if tmp1325 (apply (lambda (_1326 e11327 e21328) (cons (quote #(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i"))) (hygiene guile))) (cons e11327 e21328))) tmp1325) ((lambda (tmp1330) (if tmp1330 (apply (lambda (_1331 out1332 in1333 e11334 e21335) (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))) in1333 (quote ()) (list out1332 (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 e11334 e21335))))) tmp1330) ((lambda (tmp1337) (if tmp1337 (apply (lambda (_1338 out1339 in1340 e11341 e21342) (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))) in1340) (quote ()) (list out1339 (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 e11341 e21342))))) tmp1337) (syntax-violation #f "source expression failed to match any pattern" tmp1324))) ($sc-dispatch tmp1324 (quote (any #(each (any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any ((any any)) any . each-any)))))) ($sc-dispatch tmp1324 (quote (any () any . each-any))))) x1323)))) +(define syntax-rules (make-syncase-macro (quote macro) (lambda (x1346) ((lambda (tmp1347) ((lambda (tmp1348) (if tmp1348 (apply (lambda (_1349 k1350 keyword1351 pattern1352 template1353) (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 k1350 (map (lambda (tmp1356 tmp1355) (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))) tmp1355) (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))) tmp1356))) template1353 pattern1352)))))) tmp1348) (syntax-violation #f "source expression failed to match any pattern" tmp1347))) ($sc-dispatch tmp1347 (quote (any each-any . #(each ((any . any) any))))))) x1346)))) +(define let* (make-extended-syncase-macro (module-ref (current-module) (quote let*)) (quote macro) (lambda (x1357) ((lambda (tmp1358) ((lambda (tmp1359) (if (if tmp1359 (apply (lambda (let*1360 x1361 v1362 e11363 e21364) (and-map identifier? x1361)) tmp1359) #f) (apply (lambda (let*1366 x1367 v1368 e11369 e21370) (letrec ((f1371 (lambda (bindings1372) (if (null? bindings1372) (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 e11369 e21370))) ((lambda (tmp1376) ((lambda (tmp1377) (if tmp1377 (apply (lambda (body1378 binding1379) (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 binding1379) body1378)) tmp1377) (syntax-violation #f "source expression failed to match any pattern" tmp1376))) ($sc-dispatch tmp1376 (quote (any any))))) (list (f1371 (cdr bindings1372)) (car bindings1372))))))) (f1371 (map list x1367 v1368)))) tmp1359) (syntax-violation #f "source expression failed to match any pattern" tmp1358))) ($sc-dispatch tmp1358 (quote (any #(each (any any)) any . each-any))))) x1357)))) +(define do (make-extended-syncase-macro (module-ref (current-module) (quote do)) (quote macro) (lambda (orig-x1380) ((lambda (tmp1381) ((lambda (tmp1382) (if tmp1382 (apply (lambda (_1383 var1384 init1385 step1386 e01387 e11388 c1389) ((lambda (tmp1390) ((lambda (tmp1391) (if tmp1391 (apply (lambda (step1392) ((lambda (tmp1393) ((lambda (tmp1394) (if tmp1394 (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 var1384 init1385) (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))) e01387) (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 c1389 (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))) step1392))))))) tmp1394) ((lambda (tmp1399) (if tmp1399 (apply (lambda (e11400 e21401) (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 var1384 init1385) (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))) e01387 (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 e11400 e21401)) (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 c1389 (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))) step1392))))))) tmp1399) (syntax-violation #f "source expression failed to match any pattern" tmp1393))) ($sc-dispatch tmp1393 (quote (any . each-any)))))) ($sc-dispatch tmp1393 (quote ())))) e11388)) tmp1391) (syntax-violation #f "source expression failed to match any pattern" tmp1390))) ($sc-dispatch tmp1390 (quote each-any)))) (map (lambda (v1408 s1409) ((lambda (tmp1410) ((lambda (tmp1411) (if tmp1411 (apply (lambda () v1408) tmp1411) ((lambda (tmp1412) (if tmp1412 (apply (lambda (e1413) e1413) tmp1412) ((lambda (_1414) (syntax-violation (quote do) "bad step expression" orig-x1380 s1409)) tmp1410))) ($sc-dispatch tmp1410 (quote (any)))))) ($sc-dispatch tmp1410 (quote ())))) s1409)) var1384 step1386))) tmp1382) (syntax-violation #f "source expression failed to match any pattern" tmp1381))) ($sc-dispatch tmp1381 (quote (any #(each (any any . any)) (any . each-any) . each-any))))) orig-x1380)))) +(define quasiquote (make-extended-syncase-macro (module-ref (current-module) (quote quasiquote)) (quote macro) (letrec ((quasicons1417 (lambda (x1421 y1422) ((lambda (tmp1423) ((lambda (tmp1424) (if tmp1424 (apply (lambda (x1425 y1426) ((lambda (tmp1427) ((lambda (tmp1428) (if tmp1428 (apply (lambda (dy1429) ((lambda (tmp1430) ((lambda (tmp1431) (if tmp1431 (apply (lambda (dx1432) (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 dx1432 dy1429))) tmp1431) ((lambda (_1433) (if (null? dy1429) (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))) x1425) (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))) x1425 y1426))) tmp1430))) ($sc-dispatch tmp1430 (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))))) x1425)) tmp1428) ((lambda (tmp1434) (if tmp1434 (apply (lambda (stuff1435) (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 x1425 stuff1435))) tmp1434) ((lambda (else1436) (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))) x1425 y1426)) tmp1427))) ($sc-dispatch tmp1427 (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 tmp1427 (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))))) y1426)) tmp1424) (syntax-violation #f "source expression failed to match any pattern" tmp1423))) ($sc-dispatch tmp1423 (quote (any any))))) (list x1421 y1422)))) (quasiappend1418 (lambda (x1437 y1438) ((lambda (tmp1439) ((lambda (tmp1440) (if tmp1440 (apply (lambda (x1441 y1442) ((lambda (tmp1443) ((lambda (tmp1444) (if tmp1444 (apply (lambda () x1441) tmp1444) ((lambda (_1445) (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))) x1441 y1442)) tmp1443))) ($sc-dispatch tmp1443 (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))) ()))))) y1442)) tmp1440) (syntax-violation #f "source expression failed to match any pattern" tmp1439))) ($sc-dispatch tmp1439 (quote (any any))))) (list x1437 y1438)))) (quasivector1419 (lambda (x1446) ((lambda (tmp1447) ((lambda (x1448) ((lambda (tmp1449) ((lambda (tmp1450) (if tmp1450 (apply (lambda (x1451) (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 x1451))) tmp1450) ((lambda (tmp1453) (if tmp1453 (apply (lambda (x1454) (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))) x1454)) tmp1453) ((lambda (_1456) (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))) x1448)) tmp1449))) ($sc-dispatch tmp1449 (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 tmp1449 (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))))) x1448)) tmp1447)) x1446))) (quasi1420 (lambda (p1457 lev1458) ((lambda (tmp1459) ((lambda (tmp1460) (if tmp1460 (apply (lambda (p1461) (if (= lev1458 0) p1461 (quasicons1417 (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)))) (quasi1420 (list p1461) (- lev1458 1))))) tmp1460) ((lambda (tmp1462) (if tmp1462 (apply (lambda (p1463 q1464) (if (= lev1458 0) (quasiappend1418 p1463 (quasi1420 q1464 lev1458)) (quasicons1417 (quasicons1417 (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)))) (quasi1420 (list p1463) (- lev1458 1))) (quasi1420 q1464 lev1458)))) tmp1462) ((lambda (tmp1465) (if tmp1465 (apply (lambda (p1466) (quasicons1417 (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)))) (quasi1420 (list p1466) (+ lev1458 1)))) tmp1465) ((lambda (tmp1467) (if tmp1467 (apply (lambda (p1468 q1469) (quasicons1417 (quasi1420 p1468 lev1458) (quasi1420 q1469 lev1458))) tmp1467) ((lambda (tmp1470) (if tmp1470 (apply (lambda (x1471) (quasivector1419 (quasi1420 x1471 lev1458))) tmp1470) ((lambda (p1473) (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))) p1473)) tmp1459))) ($sc-dispatch tmp1459 (quote #(vector each-any)))))) ($sc-dispatch tmp1459 (quote (any . any)))))) ($sc-dispatch tmp1459 (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 tmp1459 (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 tmp1459 (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))))) p1457)))) (lambda (x1474) ((lambda (tmp1475) ((lambda (tmp1476) (if tmp1476 (apply (lambda (_1477 e1478) (quasi1420 e1478 0)) tmp1476) (syntax-violation #f "source expression failed to match any pattern" tmp1475))) ($sc-dispatch tmp1475 (quote (any any))))) x1474))))) +(define include (make-syncase-macro (quote macro) (lambda (x1479) (letrec ((read-file1480 (lambda (fn1481 k1482) (let ((p1483 (open-input-file fn1481))) (letrec ((f1484 (lambda (x1485) (if (eof-object? x1485) (begin (close-input-port p1483) (quote ())) (cons (datum->syntax k1482 x1485) (f1484 (read p1483))))))) (f1484 (read p1483))))))) ((lambda (tmp1486) ((lambda (tmp1487) (if tmp1487 (apply (lambda (k1488 filename1489) (let ((fn1490 (syntax->datum filename1489))) ((lambda (tmp1491) ((lambda (tmp1492) (if tmp1492 (apply (lambda (exp1493) (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))) exp1493)) tmp1492) (syntax-violation #f "source expression failed to match any pattern" tmp1491))) ($sc-dispatch tmp1491 (quote each-any)))) (read-file1480 fn1490 k1488)))) tmp1487) (syntax-violation #f "source expression failed to match any pattern" tmp1486))) ($sc-dispatch tmp1486 (quote (any any))))) x1479))))) +(define unquote (make-syncase-macro (quote macro) (lambda (x1495) ((lambda (tmp1496) ((lambda (tmp1497) (if tmp1497 (apply (lambda (_1498 e1499) (syntax-violation (quote unquote) "expression not valid outside of quasiquote" x1495)) tmp1497) (syntax-violation #f "source expression failed to match any pattern" tmp1496))) ($sc-dispatch tmp1496 (quote (any any))))) x1495)))) +(define unquote-splicing (make-syncase-macro (quote macro) (lambda (x1500) ((lambda (tmp1501) ((lambda (tmp1502) (if tmp1502 (apply (lambda (_1503 e1504) (syntax-violation (quote unquote-splicing) "expression not valid outside of quasiquote" x1500)) tmp1502) (syntax-violation #f "source expression failed to match any pattern" tmp1501))) ($sc-dispatch tmp1501 (quote (any any))))) x1500)))) +(define case (make-extended-syncase-macro (module-ref (current-module) (quote case)) (quote macro) (lambda (x1505) ((lambda (tmp1506) ((lambda (tmp1507) (if tmp1507 (apply (lambda (_1508 e1509 m11510 m21511) ((lambda (tmp1512) ((lambda (body1513) (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))) e1509)) body1513)) tmp1512)) (letrec ((f1514 (lambda (clause1515 clauses1516) (if (null? clauses1516) ((lambda (tmp1518) ((lambda (tmp1519) (if tmp1519 (apply (lambda (e11520 e21521) (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 e11520 e21521))) tmp1519) ((lambda (tmp1523) (if tmp1523 (apply (lambda (k1524 e11525 e21526) (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))) k1524)) (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 e11525 e21526)))) tmp1523) ((lambda (_1529) (syntax-violation (quote case) "bad clause" x1505 clause1515)) tmp1518))) ($sc-dispatch tmp1518 (quote (each-any any . each-any)))))) ($sc-dispatch tmp1518 (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))))) clause1515) ((lambda (tmp1530) ((lambda (rest1531) ((lambda (tmp1532) ((lambda (tmp1533) (if tmp1533 (apply (lambda (k1534 e11535 e21536) (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))) k1534)) (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 e11535 e21536)) rest1531)) tmp1533) ((lambda (_1539) (syntax-violation (quote case) "bad clause" x1505 clause1515)) tmp1532))) ($sc-dispatch tmp1532 (quote (each-any any . each-any))))) clause1515)) tmp1530)) (f1514 (car clauses1516) (cdr clauses1516))))))) (f1514 m11510 m21511)))) tmp1507) (syntax-violation #f "source expression failed to match any pattern" tmp1506))) ($sc-dispatch tmp1506 (quote (any any any . each-any))))) x1505)))) +(define identifier-syntax (make-syncase-macro (quote macro) (lambda (x1540) ((lambda (tmp1541) ((lambda (tmp1542) (if tmp1542 (apply (lambda (_1543 e1544) (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))) e1544)) (list (cons _1543 (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 e1544 (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)))))))))) tmp1542) (syntax-violation #f "source expression failed to match any pattern" tmp1541))) ($sc-dispatch tmp1541 (quote (any any))))) x1540)))) -- 2.20.1