1(define (foo) 1) 2 3(assert (= 1 (foo))) 4 5(define-compiler-syntax foo 6 (syntax-rules () 7 ((_ x) 2) ) ) 8 9(assert (= 2 (foo 42))) 10(assert (= 1 (foo))) 11 12(let-compiler-syntax ((foo (syntax-rules () ((_ x) 3)))) 13 (assert (= 3 (foo 42)))) 14 15(assert (= 2 (foo 42))) 16 17(module m1 (bar) 18 (import (prefix scheme s:) (chicken syntax)) 19 (define-compiler-syntax s:+ 20 (syntax-rules () 21 ((_ x y) (s:- x y)))) 22 (define-compiler-syntax bar 23 (syntax-rules () 24 ((_ x y) "oink!"))) 25 (s:define (bar x) (s:+ x 1)) ) 26 27(module m2 () 28 (import scheme (chicken base) (prefix m1 m-)) 29 (print (m-bar 10)) 30 (assert (= 9 (m-bar 10))) 31 (print (+ 4 3))) 32 33(define (goo x) `(goo ,x)) 34 35(assert (eq? 'goo (car (goo 1)))) 36 37(define-compiler-syntax goo 38 (syntax-rules () 39 ((_ x) `(cs-goo ,x)))) 40 41(print (goo 2)) 42(assert (eq? 'cs-goo (car (goo 2)))) 43 44(define-compiler-syntax goo) 45 46(assert (eq? 'goo (car (goo 3)))) 47 48(define-compiler-syntax goo 49 (syntax-rules () 50 ((_ x) `(cs-goo2 ,x)))) 51 52(let-compiler-syntax ((goo)) 53 (assert (eq? 'goo (car (goo 4))))) 54 55(assert (eq? 'cs-goo2 (car (goo 5)))) 56 57(module bar (xxx) 58 (import scheme (chicken syntax) (chicken base)) 59 (define (xxx) 'yyy) ; ineffective - suboptimal 60 ;(assert (eq? 'yyy (xxx))) 61 (define-compiler-syntax xxx 62 (syntax-rules () 63 ((_) 'zzz))) 64 (define-syntax alias 65 (syntax-rules () 66 ((_ name x) 67 (define-compiler-syntax name 68 (syntax-rules () 69 ((_ . args) (x . args))))))) 70 (alias pof +) 71 (alias pif xxx) 72 (assert (= 7 (pof 3 4))) 73 (assert (eq? 'zzz (pif))) 74 (print (xxx)) 75 (assert (eq? 'zzz (xxx)))) 76 77;;; local to module 78 79(define (f1 x) x) 80 81(module m3 () 82(import scheme (chicken syntax)) 83(define-compiler-syntax f1 84 (syntax-rules () ((_ x) (list x)))) 85) 86 87(assert (= 2 (f1 2))) 88