1;;  Filename : test-letrec.scm
2;;  About    : unit test for R5RS letrec
3;;
4;;  Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp>
5;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
6;;
7;;  All rights reserved.
8;;
9;;  Redistribution and use in source and binary forms, with or without
10;;  modification, are permitted provided that the following conditions
11;;  are met:
12;;
13;;  1. Redistributions of source code must retain the above copyright
14;;     notice, this list of conditions and the following disclaimer.
15;;  2. Redistributions in binary form must reproduce the above copyright
16;;     notice, this list of conditions and the following disclaimer in the
17;;     documentation and/or other materials provided with the distribution.
18;;  3. Neither the name of authors nor the names of its contributors
19;;     may be used to endorse or promote products derived from this software
20;;     without specific prior written permission.
21;;
22;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
23;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
24;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
25;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
26;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
34(require-extension (unittest))
35
36(define *test-track-progress* #f)
37(define tn test-name)
38
39
40;;
41;; letrec
42;;
43(tn "letrec invalid form")
44;; bindings and body required
45(assert-error  (tn) (lambda ()
46                      (letrec)))
47(assert-error  (tn) (lambda ()
48                      (letrec ())))
49(assert-error  (tn) (lambda ()
50                      (letrec ((a)))))
51(assert-error  (tn) (lambda ()
52                      (letrec ((a 1)))))
53(assert-error  (tn) (lambda ()
54                      (letrec (a 1))))
55(assert-error  (tn) (lambda ()
56                      (letrec a)))
57(assert-error  (tn) (lambda ()
58                      (letrec #())))
59(assert-error  (tn) (lambda ()
60                      (letrec #f)))
61(assert-error  (tn) (lambda ()
62                      (letrec #t)))
63;; bindings must be a list
64(assert-error  (tn) (lambda ()
65                      (letrec a 'val)))
66(if (provided? "siod-bugs")
67    (assert-equal? (tn)
68                   'val
69                   (letrec #f 'val))
70    (assert-error  (tn) (lambda ()
71                          (letrec #f 'val))))
72(assert-error  (tn) (lambda ()
73                      (letrec #() 'val)))
74(assert-error  (tn) (lambda ()
75                      (letrec #t 'val)))
76;; each binding must be a 2-elem list
77(assert-error  (tn) (lambda ()
78                      (letrec (a 1) 'val)))
79(assert-error  (tn)
80               (lambda ()
81                 (letrec ((a)) 'val)))
82(assert-error  (tn)
83               (lambda ()
84                 (letrec ((a 1 'excessive)) 'val)))
85(assert-error  (tn)
86               (lambda ()
87                 (letrec ((a 1) . (b 2)) 'val)))
88(assert-error  (tn)
89               (lambda ()
90                 (letrec ((a . 1)) 'val)))
91(assert-error  (tn)
92               (lambda ()
93                 (letrec ((a  1)) . a)))
94(assert-error  (tn)
95               (lambda ()
96                 (letrec ((a  1)) 'val . a)))
97(assert-error  (tn)
98               (lambda ()
99                 (letrec (1) #t)))
100
101(tn "letrec binding syntactic keyword")
102(assert-equal? (tn) 7 (letrec ((else 7)) else))
103(assert-equal? (tn) 8 (letrec ((=> 8)) =>))
104(assert-equal? (tn) 9 (letrec ((unquote 9)) unquote))
105(assert-error  (tn) (lambda () else))
106(assert-error  (tn) (lambda () =>))
107(assert-error  (tn) (lambda () unquote))
108
109(tn "letrec env isolation")
110;; referencing a variable within bindings evaluation is invalid
111(assert-error  (tn)
112               (lambda ()
113                 (letrec ((var1 1)
114                          (var2 var1))
115                   'result)))
116(assert-error  (tn)
117               (lambda ()
118                 (letrec ((var1 var2)
119                          (var2 2))
120                   'result)))
121;; all variables are kept unbound until body evaluation
122(assert-equal? (tn)
123               '(#f #f #f)
124               (letrec ((var1 (symbol-bound? 'var1))
125                        (var2 (symbol-bound? 'var1))
126                        (var3 (symbol-bound? 'var1)))
127                 (list var1 var2 var3)))
128(assert-equal? (tn)
129               '(#f #f #f)
130               (letrec ((var1 (symbol-bound? 'var2))
131                        (var2 (symbol-bound? 'var2))
132                        (var3 (symbol-bound? 'var2)))
133                 (list var1 var2 var3)))
134(assert-equal? (tn)
135               '(#f #f #f)
136               (letrec ((var1 (symbol-bound? 'var3))
137                        (var2 (symbol-bound? 'var3))
138                        (var3 (symbol-bound? 'var3)))
139                 (list var1 var2 var3)))
140;; all variables can be referred from any position of the bindings
141(assert-equal? (tn)
142               '(#t #t #t)
143               (letrec ((var1 (lambda () var1))
144                        (var2 (lambda () var1))
145                        (var3 (lambda () var1)))
146                 (list (eq? (var1) var1)
147                       (eq? (var2) var1)
148                       (eq? (var3) var1))))
149(assert-equal? (tn)
150               '(#t #t #t)
151               (letrec ((var1 (lambda () var2))
152                        (var2 (lambda () var2))
153                        (var3 (lambda () var2)))
154                 (list (eq? (var1) var2)
155                       (eq? (var2) var2)
156                       (eq? (var3) var2))))
157(assert-equal? (tn)
158               '(#t #t #t)
159               (letrec ((var1 (lambda () var3))
160                        (var2 (lambda () var3))
161                        (var3 (lambda () var3)))
162                 (list (eq? (var1) var3)
163                       (eq? (var2) var3)
164                       (eq? (var3) var3))))
165
166(tn "letrec internal definitions lacking sequence part")
167;; at least one <expression> is required
168(assert-error  (tn)
169               (lambda ()
170                 (letrec ()
171                   (define var1 1))))
172(assert-error  (tn)
173               (lambda ()
174                 (letrec ()
175                   (define (proc1) 1))))
176(assert-error  (tn)
177               (lambda ()
178                 (letrec ()
179                   (define var1 1)
180                   (define var2 2))))
181(assert-error  (tn)
182               (lambda ()
183                 (letrec ()
184                   (define (proc1) 1)
185                   (define (proc2) 2))))
186(assert-error  (tn)
187               (lambda ()
188                 (letrec ()
189                   (define var1 1)
190                   (define (proc2) 2))))
191(assert-error  (tn)
192               (lambda ()
193                 (letrec ()
194                   (define (proc1) 1)
195                   (define var2 2))))
196(assert-error  (tn)
197               (lambda ()
198                 (letrec ()
199                   (begin))))
200(assert-error  (tn)
201               (lambda ()
202                 (letrec ()
203                   (begin
204                     (define var1 1)))))
205(assert-error  (tn)
206               (lambda ()
207                 (letrec ()
208                   (begin
209                     (define (proc1) 1)))))
210(assert-error  (tn)
211               (lambda ()
212                 (letrec ()
213                   (begin
214                     (define var1 1)
215                     (define var2 2)))))
216(assert-error  (tn)
217               (lambda ()
218                 (letrec ()
219                   (begin
220                     (define (proc1) 1)
221                     (define (proc2) 2)))))
222(assert-error  (tn)
223               (lambda ()
224                 (letrec ()
225                   (begin
226                     (define var1 1)
227                     (define (proc2) 2)))))
228(assert-error  (tn)
229               (lambda ()
230                 (letrec ()
231                   (begin
232                     (define (proc1) 1)
233                     (define var2 2)))))
234;; appending a non-definition expression into a begin block is invalid
235(assert-error  (tn)
236               (lambda ()
237                 (letrec ()
238                   (begin
239                     (define var1 1)
240                     'val))))
241(assert-error  (tn)
242               (lambda ()
243                 (letrec ()
244                   (begin
245                     (define (proc1) 1)
246                     'val))))
247(assert-error  (tn)
248               (lambda ()
249                 (letrec ()
250                   (begin
251                     (define var1 1)
252                     (define var2 2)
253                     'val))))
254(assert-error  (tn)
255               (lambda ()
256                 (letrec ()
257                   (begin
258                     (define (proc1) 1)
259                     (define (proc2) 2)
260                     'val))))
261(assert-error  (tn)
262               (lambda ()
263                 (letrec ()
264                   (begin
265                     (define var1 1)
266                     (define (proc2) 2)
267                     'val))))
268(assert-error  (tn)
269               (lambda ()
270                 (letrec ()
271                   (begin
272                     (define (proc1) 1)
273                     (define var2 2)
274                     'val))))
275
276(tn "letrec internal definitions cross reference")
277;; R5RS: 5.2.2 Internal definitions
278;; Just as for the equivalent `letrec' expression, it must be possible to
279;; evaluate each <expression> of every internal definition in a <body> without
280;; assigning or referring to the value of any <variable> being defined.
281(assert-error  (tn)
282               (lambda ()
283                 (letrec ()
284                   (define var1 1)
285                   (define var2 var1)
286                   'val)))
287(assert-error  (tn)
288               (lambda ()
289                 (letrec ()
290                   (define var1 var2)
291                   (define var2 2)
292                   'val)))
293(assert-error  (tn)
294               (lambda ()
295                 (letrec ()
296                   (define var1 var1)
297                   'val)))
298(assert-equal? (tn)
299               '(0 0 0 0 0)
300               (letrec ((var0 0))
301                 (define var1 var0)
302                 (define var2 var0)
303                 (begin
304                   (define var3 var0)
305                   (begin
306                     (define var4 var0)))
307                 (define var5 var0)
308                 (list var1 var2 var3 var4 var5)))
309(assert-equal? (tn)
310               '(#f #f #f #f #f #f)
311               (letrec ((var0 (symbol-bound? 'var1)))
312                 (define var1 (symbol-bound? 'var1))
313                 (define var2 (symbol-bound? 'var1))
314                 (begin
315                   (define var3 (symbol-bound? 'var1))
316                   (begin
317                     (define var4 (symbol-bound? 'var1))))
318                 (define var5 (symbol-bound? 'var1))
319                 (list var0 var1 var2 var3 var4 var5)))
320(assert-equal? (tn)
321               '(#f #f #f #f #f #f)
322               (letrec ((var0 (symbol-bound? 'var2)))
323                 (define var1 (symbol-bound? 'var2))
324                 (define var2 (symbol-bound? 'var2))
325                 (begin
326                   (define var3 (symbol-bound? 'var2))
327                   (begin
328                     (define var4 (symbol-bound? 'var2))))
329                 (define var5 (symbol-bound? 'var2))
330                 (list var0 var1 var2 var3 var4 var5)))
331(assert-equal? (tn)
332               '(#f #f #f #f #f #f)
333               (letrec ((var0 (symbol-bound? 'var3)))
334                 (define var1 (symbol-bound? 'var3))
335                 (define var2 (symbol-bound? 'var3))
336                 (begin
337                   (define var3 (symbol-bound? 'var3))
338                   (begin
339                     (define var4 (symbol-bound? 'var3))))
340                 (define var5 (symbol-bound? 'var3))
341                 (list var0 var1 var2 var3 var4 var5)))
342(assert-equal? (tn)
343               '(#f #f #f #f #f #f)
344               (letrec ((var0 (symbol-bound? 'var4)))
345                 (define var1 (symbol-bound? 'var4))
346                 (define var2 (symbol-bound? 'var4))
347                 (begin
348                   (define var3 (symbol-bound? 'var4))
349                   (begin
350                     (define var4 (symbol-bound? 'var4))))
351                 (define var5 (symbol-bound? 'var4))
352                 (list var0 var1 var2 var3 var4 var5)))
353(assert-equal? (tn)
354               '(#f #f #f #f #f #f)
355               (letrec ((var0 (symbol-bound? 'var5)))
356                 (define var1 (symbol-bound? 'var5))
357                 (define var2 (symbol-bound? 'var5))
358                 (begin
359                   (define var3 (symbol-bound? 'var5))
360                   (begin
361                     (define var4 (symbol-bound? 'var5))))
362                 (define var5 (symbol-bound? 'var5))
363                 (list var0 var1 var2 var3 var4 var5)))
364;; outer let cannot refer internal variable even if letrec
365(assert-error  (tn)
366               (lambda ()
367                 (letrec ((var0 (lambda () var1)))
368                   (define var1 (lambda () 1))
369                   (eq? (var0) var0))))
370;; defining procedure can refer other (and self) variables as if letrec
371(assert-equal? (tn)
372               '(#t #t #t #t #t)
373               (letrec ((var0 (lambda () 0)))
374                 (define var1 (lambda () var0))
375                 (define var2 (lambda () var0))
376                 (begin
377                   (define var3 (lambda () var0))
378                   (begin
379                     (define var4 (lambda () var0))))
380                 (define var5 (lambda () var0))
381                 (list (eq? (var1) var0)
382                       (eq? (var2) var0)
383                       (eq? (var3) var0)
384                       (eq? (var4) var0)
385                       (eq? (var5) var0))))
386(assert-equal? (tn)
387               '(#t #t #t #t #t)
388               (letrec ()
389                 (define var1 (lambda () var1))
390                 (define var2 (lambda () var1))
391                 (begin
392                   (define var3 (lambda () var1))
393                   (begin
394                     (define var4 (lambda () var1))))
395                 (define var5 (lambda () var1))
396                 (list (eq? (var1) var1)
397                       (eq? (var2) var1)
398                       (eq? (var3) var1)
399                       (eq? (var4) var1)
400                       (eq? (var5) var1))))
401(assert-equal? (tn)
402               '(#t #t #t #t #t)
403               (letrec ()
404                 (define var1 (lambda () var2))
405                 (define var2 (lambda () var2))
406                 (begin
407                   (define var3 (lambda () var2))
408                   (begin
409                     (define var4 (lambda () var2))))
410                 (define var5 (lambda () var2))
411                 (list (eq? (var1) var2)
412                       (eq? (var2) var2)
413                       (eq? (var3) var2)
414                       (eq? (var4) var2)
415                       (eq? (var5) var2))))
416(assert-equal? (tn)
417               '(#t #t #t #t #t)
418               (letrec ()
419                 (define var1 (lambda () var3))
420                 (define var2 (lambda () var3))
421                 (begin
422                   (define var3 (lambda () var3))
423                   (begin
424                     (define var4 (lambda () var3))))
425                 (define var5 (lambda () var3))
426                 (list (eq? (var1) var3)
427                       (eq? (var2) var3)
428                       (eq? (var3) var3)
429                       (eq? (var4) var3)
430                       (eq? (var5) var3))))
431(assert-equal? (tn)
432               '(#t #t #t #t #t)
433               (letrec ()
434                 (define var1 (lambda () var4))
435                 (define var2 (lambda () var4))
436                 (begin
437                   (define var3 (lambda () var4))
438                   (begin
439                     (define var4 (lambda () var4))))
440                 (define var5 (lambda () var4))
441                 (list (eq? (var1) var4)
442                       (eq? (var2) var4)
443                       (eq? (var3) var4)
444                       (eq? (var4) var4)
445                       (eq? (var5) var4))))
446(assert-equal? (tn)
447               '(#t #t #t #t #t)
448               (letrec ()
449                 (define var1 (lambda () var5))
450                 (define var2 (lambda () var5))
451                 (begin
452                   (define var3 (lambda () var5))
453                   (begin
454                     (define var4 (lambda () var5))))
455                 (define var5 (lambda () var5))
456                 (list (eq? (var1) var5)
457                       (eq? (var2) var5)
458                       (eq? (var3) var5)
459                       (eq? (var4) var5)
460                       (eq? (var5) var5))))
461
462(tn "letrec internal definitions valid forms")
463;; valid internal definitions
464(assert-equal? (tn)
465               '(1)
466               (letrec ()
467                 (define var1 1)
468                 (list var1)))
469(assert-equal? (tn)
470               '(1)
471               (letrec ()
472                 (define (proc1) 1)
473                 (list (proc1))))
474(assert-equal? (tn)
475               '(1 2)
476               (letrec ()
477                 (define var1 1)
478                 (define var2 2)
479                 (list var1 var2)))
480(assert-equal? (tn)
481               '(1 2)
482               (letrec ()
483                 (define (proc1) 1)
484                 (define (proc2) 2)
485                 (list (proc1) (proc2))))
486(assert-equal? (tn)
487               '(1 2)
488               (letrec ()
489                 (define var1 1)
490                 (define (proc2) 2)
491                 (list var1 (proc2))))
492(assert-equal? (tn)
493               '(1 2)
494               (letrec ()
495                 (define (proc1) 1)
496                 (define var2 2)
497                 (list (proc1) var2)))
498;; SigScheme accepts '(begin)' as valid internal definition '(begin
499;; <definition>*)' as defined in "7.1.6 Programs and definitions" of R5RS
500;; although it is rejected as expression '(begin <sequence>)' as defined in
501;; "7.1.3 Expressions".
502(assert-equal? (tn)
503               1
504               (letrec ()
505                 (begin)
506                 1))
507(assert-equal? (tn)
508               1
509               (letrec ()
510                 (begin)
511                 (define var1 1)
512                 (begin)
513                 1))
514(assert-equal? (tn)
515               '(1)
516               (letrec ()
517                 (begin
518                   (define var1 1))
519                 (list var1)))
520(assert-equal? (tn)
521               '(1)
522               (letrec ()
523                 (begin
524                   (define (proc1) 1))
525                 (list (proc1))))
526(assert-equal? (tn)
527               '(1 2)
528               (letrec ()
529                 (begin
530                   (define var1 1)
531                   (define var2 2))
532                 (list var1 var2)))
533(assert-equal? (tn)
534               '(1 2)
535               (letrec ()
536                 (begin
537                   (define (proc1) 1)
538                   (define (proc2) 2))
539                 (list (proc1) (proc2))))
540(assert-equal? (tn)
541               '(1 2)
542               (letrec ()
543                 (begin
544                   (define var1 1)
545                   (define (proc2) 2))
546                 (list var1 (proc2))))
547(assert-equal? (tn)
548               '(1 2)
549               (letrec ()
550                 (begin
551                   (define (proc1) 1)
552                   (define var2 2))
553                 (list (proc1) var2)))
554(assert-equal? (tn)
555               '(1 2 3 4 5 6)
556               (letrec ()
557                 (begin
558                   (define (proc1) 1)
559                   (define var2 2)
560                   (begin
561                     (define (proc3) 3)
562                     (define var4 4)
563                     (begin
564                       (define (proc5) 5)
565                       (define var6 6))))
566                 (list (proc1) var2
567                       (proc3) var4
568                       (proc5) var6)))
569;; begin block and single definition mixed
570(assert-equal? (tn)
571               '(1 2 3 4 5 6)
572               (letrec ()
573                 (begin)
574                 (define (proc1) 1)
575                 (begin
576                   (define var2 2)
577                   (begin
578                     (define (proc3) 3)
579                     (begin)
580                     (define var4 4)))
581                 (begin)
582                 (define (proc5) 5)
583                 (begin
584                   (begin
585                     (begin
586                       (begin)))
587                   (define var6 6)
588                   (begin))
589                 (begin)
590                 (list (proc1) var2
591                       (proc3) var4
592                       (proc5) var6)))
593
594(tn "letrec internal definitions invalid begin blocks")
595;; appending a non-definition expression into a begin block is invalid
596(assert-error  (tn)
597               (lambda ()
598                 (letrec ()
599                   (begin
600                     (define var1 1)
601                     'val)
602                   (list var1))))
603(assert-error  (tn)
604               (lambda ()
605                 (letrec ()
606                   (begin
607                     (define (proc1) 1)
608                     'val)
609                   (list (proc1)))))
610(assert-error  (tn)
611               (lambda ()
612                 (letrec ()
613                   (begin
614                     (define var1 1)
615                     (define var2 2)
616                     'val)
617                   (list var1 var2))))
618(assert-error  (tn)
619               (lambda ()
620                 (letrec ()
621                   (begin
622                     (define (proc1) 1)
623                     (define (proc2) 2)
624                     'val)
625                   (list (proc1) (proc2)))))
626(assert-error  (tn)
627               (lambda ()
628                 (letrec ()
629                   (begin
630                     (define var1 1)
631                     (define (proc2) 2)
632                     'val)
633                   (list var1 (proc2)))))
634(assert-error  (tn)
635               (lambda ()
636                 (letrec ()
637                   (begin
638                     (define (proc1) 1)
639                     (define var2 2)
640                     'val)
641                   (list (proc1) var2))))
642(assert-error  (tn)
643               (lambda ()
644                 (letrec ()
645                   (begin
646                     (define (proc1) 1)
647                     (define var2 2)
648                     (begin
649                       (define (proc3) 3)
650                       (define var4 4)
651                       (begin
652                         (define (proc5) 5)
653                         (define var6 6)
654                         'val)))
655                   (list (proc1) var2
656                         (proc3) var4
657                         (proc5) var6))))
658
659(tn "letrec internal definitions invalid placement")
660;; a non-definition expression prior to internal definition is invalid
661(assert-error  (tn)
662               (lambda ()
663                 (letrec ()
664                   'val
665                   (define var1 1))))
666(assert-error  (tn)
667               (lambda ()
668                 (letrec ()
669                   'val
670                   (define (proc1) 1))))
671(assert-error  (tn)
672               (lambda ()
673                 (letrec ()
674                   'val
675                   (define var1 1)
676                   (define var2 2))))
677(assert-error  (tn)
678               (lambda ()
679                 (letrec ()
680                   'val
681                   (define (proc1) 1)
682                   (define (proc2) 2))))
683(assert-error  (tn)
684               (lambda ()
685                 (letrec ()
686                   'val
687                   (define var1 1)
688                   (define (proc2) 2))))
689(assert-error  (tn)
690               (lambda ()
691                 (letrec ()
692                   'val
693                   (define (proc1) 1)
694                   (define var2 2))))
695(assert-error  (tn)
696               (lambda ()
697                 (letrec ()
698                   'val
699                   (begin))))
700(assert-error  (tn)
701               (lambda ()
702                 (letrec ()
703                   'val
704                   (begin
705                     (define var1 1)))))
706(assert-error  (tn)
707               (lambda ()
708                 (letrec ()
709                   'val
710                   (begin
711                     (define (proc1) 1)))))
712(assert-error  (tn)
713               (lambda ()
714                 (letrec ()
715                   'val
716                   (begin
717                     (define var1 1)
718                     (define var2 2)))))
719(assert-error  (tn)
720               (lambda ()
721                 (letrec ()
722                   'val
723                   (begin
724                     (define (proc1) 1)
725                     (define (proc2) 2)))))
726(assert-error  (tn)
727               (lambda ()
728                 (letrec ()
729                   'val
730                   (begin
731                     (define var1 1)
732                     (define (proc2) 2)))))
733(assert-error  (tn)
734               (lambda ()
735                 (letrec ()
736                   'val
737                   (begin
738                     (define (proc1) 1)
739                     (define var2 2)))))
740(assert-error  (tn)
741               (lambda ()
742                 (letrec ()
743                   'val
744                   (begin
745                     (define (proc1) 1)
746                     (define var2 2)
747                     (begin
748                       (define (proc3) 3)
749                       (define var4 4)
750                       (begin
751                         (define (proc5) 5)
752                         (define var6 6)))))))
753(assert-error  (tn)
754               (lambda ()
755                 (letrec ()
756                   (begin
757                     (define (proc1) 1)
758                     (define var2 2)
759                     'val
760                     (begin
761                       (define (proc3) 3)
762                       (define var4 4)
763                       (begin
764                         (define (proc5) 5)
765                         (define var6 6)))))))
766;; a non-definition expression prior to internal definition is invalid even if
767;; expression(s) is following the internal definition
768(assert-error  (tn)
769               (lambda ()
770                 (letrec ()
771                   'val
772                   (define var1 1)
773                   'val)))
774(assert-error  (tn)
775               (lambda ()
776                 (letrec ()
777                   'val
778                   (define (proc1) 1)
779                   'val)))
780(assert-error  (tn)
781               (lambda ()
782                 (letrec ()
783                   'val
784                   (define var1 1)
785                   (define var2 2)
786                   'val)))
787(assert-error  (tn)
788               (lambda ()
789                 (letrec ()
790                   'val
791                   (define (proc1) 1)
792                   (define (proc2) 2)
793                   'val)))
794(assert-error  (tn)
795               (lambda ()
796                 (letrec ()
797                   'val
798                   (define var1 1)
799                   (define (proc2) 2)
800                   'val)))
801(assert-error  (tn)
802               (lambda ()
803                 (letrec ()
804                   'val
805                   (define (proc1) 1)
806                   (define var2 2)
807                   'val)))
808(assert-error  (tn)
809               (lambda ()
810                 (letrec ()
811                   'val
812                   (begin)
813                   'val)))
814(assert-error  (tn)
815               (lambda ()
816                 (letrec ()
817                   'val
818                   (begin
819                     (define var1 1))
820                   'val)))
821(assert-error  (tn)
822               (lambda ()
823                 (letrec ()
824                   'val
825                   (begin
826                     (define (proc1) 1))
827                   'val)))
828(assert-error  (tn)
829               (lambda ()
830                 (letrec ()
831                   'val
832                   (begin
833                     (define var1 1)
834                     (define var2 2))
835                   'val)))
836(assert-error  (tn)
837               (lambda ()
838                 (letrec ()
839                   'val
840                   (begin
841                     (define (proc1) 1)
842                     (define (proc2) 2))
843                   'val)))
844(assert-error  (tn)
845               (lambda ()
846                 (letrec ()
847                   'val
848                   (begin
849                     (define var1 1)
850                     (define (proc2) 2))
851                   'val)))
852(assert-error  (tn)
853               (lambda ()
854                 (letrec ()
855                   'val
856                   (begin
857                     (define (proc1) 1)
858                     (define var2 2))
859                   'val)))
860(assert-error  (tn)
861               (lambda ()
862                 (letrec ()
863                   'val
864                   (begin
865                     (define (proc1) 1)
866                     (define var2 2)
867                     (begin
868                       (define (proc3) 3)
869                       (define var4 4)
870                       (begin
871                         (define (proc5) 5)
872                         (define var6 6))))
873                   (list (proc1) var2
874                         (proc3) var4
875                         (proc5) var6))))
876
877(tn "letrec binding syntactic keywords")
878(assert-error  (tn)
879               (lambda ()
880                 (letrec ((syn define))
881                   #t)))
882(assert-error  (tn)
883               (lambda ()
884                 (letrec ((syn if))
885                   #t)))
886(assert-error  (tn)
887               (lambda ()
888                 (letrec ((syn and))
889                   #t)))
890(assert-error  (tn)
891               (lambda ()
892                 (letrec ((syn cond))
893                   #t)))
894(assert-error  (tn)
895               (lambda ()
896                 (letrec ((syn begin))
897                   #t)))
898(assert-error  (tn)
899               (lambda ()
900                 (letrec ((syn do))
901                   #t)))
902(assert-error  (tn)
903               (lambda ()
904                 (letrec ((syn delay))
905                   #t)))
906(assert-error  (tn)
907               (lambda ()
908                 (letrec ((syn let*))
909                   #t)))
910(assert-error  (tn)
911               (lambda ()
912                 (letrec ((syn else))
913                   #t)))
914(assert-error  (tn)
915               (lambda ()
916                 (letrec ((syn =>))
917                   #t)))
918(assert-error  (tn)
919               (lambda ()
920                 (letrec ((syn quote))
921                   #t)))
922(assert-error  (tn)
923               (lambda ()
924                 (letrec ((syn quasiquote))
925                   #t)))
926(assert-error  (tn)
927               (lambda ()
928                 (letrec ((syn unquote))
929                   #t)))
930(assert-error  (tn)
931               (lambda ()
932                 (letrec ((syn unquote-splicing))
933                   #t)))
934
935
936(tn "letrec")
937;; empty bindings is allowed by the formal syntax spec
938(assert-equal? (tn)
939               'result
940               (letrec () 'result))
941;; duplicate variable name
942(assert-error  (tn)
943               (lambda ()
944                 (letrec ((var1 1)
945                          (var1 2))
946                   'result)))
947;; masked variable name
948(assert-equal? (tn)
949               '(#t #t #t #t #f #f #t #t #f #t)
950               (letrec ((var1 (lambda () var3))
951                        (var2 (lambda () var4))
952                        (var3 (lambda () var3))
953                        (var4 (lambda () var4))
954                        (var1in #f)
955                        (var2in #f)
956                        (var5in #f))
957                 (letrec ((var1 (lambda () var1))
958                          (var2 (lambda () var1))
959                          (var5 (lambda () var3)))
960                   (set! var1in var1)
961                   (set! var2in var2)
962                   (set! var5in var5))
963                 (list (eq? (var1) var3)
964                       (eq? (var2) var4)
965                       (eq? (var3) var3)
966                       (eq? (var4) var4)
967                       (eq? (var1in) var1)
968                       (eq? (var2in) var1)
969                       (eq? (var1in) var1in)
970                       (eq? (var2in) var1in)
971                       (eq? (var2in) var2in)
972                       (eq? (var5in) var3))))
973(assert-equal? (tn)
974               '(4 5 3)
975               (letrec ((var1 1)
976                        (var2 2)
977                        (var3 3))
978                 (letrec ((var1 4)
979                          (var2 5))
980                   (list var1 var2 var3))))
981(assert-equal? (tn)
982               '(1 2 3)
983               (letrec ((var1 1)
984                        (var2 2)
985                        (var3 3))
986                 (letrec ((var1 4)
987                          (var2 5))
988                   'dummy)
989                 (list var1 var2 var3)))
990(assert-equal? (tn)
991               '(1 2 9)
992               (letrec ((var1 1)
993                        (var2 2)
994                        (var3 3))
995                 (letrec ((var1 4)
996                          (var2 5))
997                   (set! var3 (+ var1 var2)))
998                 (list var1 var2 var3)))
999(assert-equal? (tn)
1000               '(1 2 30)
1001               (letrec ((var1 1)
1002                        (var2 2)
1003                        (var3 3))
1004                 (letrec ((var1 4)
1005                          (var2 5))
1006                   (set! var1 10)
1007                   (set! var2 20)
1008                   (set! var3 (+ var1 var2)))
1009                 (list var1 var2 var3)))
1010(assert-equal? (tn)
1011               '(1 2 3 (10 20))
1012               (letrec ((var1 1)
1013                        (var2 2)
1014                        (var3 3)
1015                        (var4 (letrec ((var1 4)
1016                                           (var2 5))
1017                                    (set! var1 10)
1018                                    (set! var2 20)
1019                                    (list var1 var2))))
1020                 (list var1 var2 var3 var4)))
1021(assert-error  (tn)
1022               (lambda ()
1023                 (letrec ((var1 1)
1024                          (var2 2)
1025                          (var3 3)
1026                          (var4 (letrec ((var1 4)
1027                                             (var2 5))
1028                                      (set! var3 10))))
1029                   (list var1 var2 var3 var4))))
1030;; variable reference
1031(assert-equal? (tn)
1032               3
1033               (letrec ((proc (lambda () var))
1034                        (var  3))
1035                 (proc)))
1036;; ordinary recursions
1037(assert-equal? (tn)
1038               4
1039               (letrec ((proc1 (lambda (n) (+ n 1)))
1040                        (proc2 (lambda (n) (proc1 n))))
1041                 (proc2 3)))
1042(assert-equal? (tn)
1043               6
1044               (letrec ((proc1 (lambda (n) (proc2 n)))
1045                        (proc2 (lambda (n) (+ n 1))))
1046                 (proc1 5)))
1047(assert-equal? (tn)
1048               #t
1049               (letrec ((even?
1050                         (lambda (n)
1051                           (if (zero? n)
1052                               #t
1053                               (odd? (- n 1)))))
1054                        (odd?
1055                         (lambda (n)
1056                           (if (zero? n)
1057                               #f
1058                               (even? (- n 1))))))
1059                 (even? 88)))
1060(assert-equal? (tn)
1061               #f
1062               (letrec ((even?
1063                         (lambda (n)
1064                           (if (zero? n)
1065                               #t
1066                               (odd? (- n 1)))))
1067                        (odd?
1068                         (lambda (n)
1069                           (if (zero? n)
1070                               #f
1071                               (even? (- n 1))))))
1072                 (odd? 88)))
1073
1074(tn "letrec lexical scope")
1075(define count-letrec
1076  (letrec ((count-letrec 0))  ;; intentionally same name
1077    (lambda ()
1078      (set! count-letrec (+ count-letrec 1))
1079      count-letrec)))
1080(assert-true   (tn) (procedure? count-letrec))
1081(assert-equal? (tn) 1 (count-letrec))
1082(assert-equal? (tn) 2 (count-letrec))
1083(assert-equal? (tn) 3 (count-letrec))
1084
1085
1086(total-report)
1087