1;;;; module-tests-2.scm 2 3 4(module oo (output-of) 5 (import scheme chicken.port) 6 (define-syntax output-of 7 (syntax-rules () 8 ((_ exp) (with-output-to-string (lambda () exp))))) 9) 10 11(module mscheme (lambda) 12 (import (rename scheme (lambda s:lambda)) 13 (chicken module)) 14 (reexport (except scheme lambda)) 15 (define-syntax lambda 16 (syntax-rules () 17 ((_ llist . body) 18 (let ((results #f)) 19 (s:lambda 20 llist 21 (if results 22 (apply values results) 23 (call-with-values (s:lambda () . body) 24 (s:lambda rs 25 (set! results rs) 26 (apply values rs))))))))) 27) 28 29(module m (f1 f2) 30 (import mscheme) 31 (define (f1) 32 (display 'f1) (newline) 33 'f1) 34 (define f2 35 (lambda () 36 (display 'f2) (newline) 37 'f2)) 38) 39 40(module mtest () 41 (import scheme m (chicken base) oo) 42 (assert (string=? "f1\n" (output-of (f1)))) 43 (assert (string=? "f1\n" (output-of (f1)))) 44 (assert (string=? "f2\n" (output-of (f2)))) 45 (assert (string=? "" (output-of (f2))))) 46 47;;; 48 49(module m1 (lambda f1 f2) 50 (import (rename scheme (lambda s:lambda))) 51 52 (define-syntax lambda 53 (syntax-rules () 54 ((_ llist . body) 55 (s:lambda llist (display 'llist) (newline) . body)))) 56 57 (define (f1) ; should use standard lambda 58 (display 'f1) 59 (newline)) 60 61 (define f2 62 (lambda (x) ; should be our lambda 63 (display 'f2) 64 (newline))) 65 66) 67 68(module mtest2 (f3 f4) 69 (import (except scheme lambda) m1 (chicken base) oo) 70 71 (define (f3) ; standard lambda 72 (display 'f3) 73 (newline)) 74 75 (define f4 ; our lambda 76 (lambda (x) 77 (display 'f4) 78 (newline))) 79 80 (assert (string=? "f1\n" (output-of (f1)))) 81 (assert (string=? "(x)\nf2\n" (output-of (f2 'yes)))) 82 (assert (string=? "f3\n" (output-of (f3)))) 83 (assert (string=? "(x)\nf4\n" (output-of (f4 'yes))))) 84 85(module m2 () 86 (import m1) 87 ((lambda () (f1)))) ; should use new lambda (but should be folded by compiler) 88 89 90;;; local define should work even with redefined define 91 92(module m3 () 93 (import (rename scheme (define s:define))) 94 (import (only (chicken base) assert)) 95 (define-syntax define 96 (syntax-rules () 97 ((_) (display 'oink)))) 98 (define) 99 (let () 100 (define a 1) 101 (assert (= a 1))) 102 (define) 103 (newline)) 104