Ticket #385: srfi26error.patch
File srfi26error.patch, 3.3 KB (added by , 14 years ago) 


chickensyntax.scm
diff git a/chickensyntax.scm b/chickensyntax.scm index f97c22a..dbf49cc 100644
a b 986 986 (let ((%<> (r '<>)) 987 987 (%<...> (r '<...>)) 988 988 (%apply (r 'apply))) 989 (when (null? (cdr form)) 990 (syntaxerror 'cute "You need to supply at least a procedure" form)) 989 991 (let loop ([xs (cdr form)] [vars '()] [vals '()] [rest #f]) 990 992 (if (null? xs) 991 993 (let ([rvars (reverse vars)] … … 999 1001 (cond ((c %<> (car xs)) 1000 1002 (let ([v (r (gensym))]) 1001 1003 (loop (cdr xs) (cons v vars) (cons v vals) #f) ) ) 1002 ((c %<...> (car xs)) (loop '() vars vals #t)) 1004 ((c %<...> (car xs)) 1005 (if (null? (cdr xs)) 1006 (loop '() vars vals #t) 1007 (syntaxerror 'cut 1008 "Tail patterns after <...> are not supported" 1009 form))) 1003 1010 (else (loop (cdr xs) vars (cons (car xs) vals) #f)) ) ) ) ) ))) 1004 1011 1005 1012 (##sys#extendmacroenvironment … … 1010 1017 (let ((%apply (r 'apply)) 1011 1018 (%<> (r '<>)) 1012 1019 (%<...> (r '<...>))) 1020 (when (null? (cdr form)) 1021 (syntaxerror 'cute "You need to supply at least a procedure" form)) 1013 1022 (let loop ([xs (cdr form)] [vars '()] [bs '()] [vals '()] [rest #f]) 1014 1023 (if (null? xs) 1015 1024 (let ([rvars (reverse vars)] … … 1025 1034 (cond ((c %<> (car xs)) 1026 1035 (let ([v (r (gensym))]) 1027 1036 (loop (cdr xs) (cons v vars) bs (cons v vals) #f) ) ) 1028 ((c %<...> (car xs)) (loop '() vars bs vals #t)) 1037 ((c %<...> (car xs)) 1038 (if (null? (cdr xs)) 1039 (loop '() vars bs vals #t) 1040 (syntaxerror 'cute 1041 "Tail patterns after <...> are not supported" 1042 form))) 1029 1043 (else 1030 1044 (let ([v (r (gensym))]) 1031 1045 (loop (cdr xs) 
tests/syntaxtests.scm
diff git a/tests/syntaxtests.scm b/tests/syntaxtests.scm index c210165..53f77dc 100644
a b 22 22 (t 3 3) 23 23 24 24 (f abc) 25 25 # 26 26 (f (t 3 4)) 27 27 28 28 ;; test syntaxrules … … 478 478 479 479 (import (prefix rfoo f:)) 480 480 (f:rbar 1) 481 # 482 ;;; SRFI26 483 484 ;; Cut 485 (t '() ((cut list))) 486 (t '() ((cut list <...>))) 487 (t '(1) ((cut list 1))) 488 (t '(1) ((cut list <>) 1)) 489 (t '(1) ((cut list <...>) 1)) 490 (t '(1 2) ((cut list 1 2))) 491 (t '(1 2) ((cut list 1 <>) 2)) 492 (t '(1 2) ((cut list 1 <...>) 2)) 493 (t '(1 2 3 4) ((cut list 1 <...>) 2 3 4)) 494 (t '(1 2 3 4) ((cut list 1 <> 3 <>) 2 4)) 495 (t '(1 2 3 4 5 6) ((cut list 1 <> 3 <...>) 2 4 5 6)) 496 (t '(ok) (let* ((x 'wrong) 497 (y (cut list x))) 498 (set! x 'ok) 499 (y))) 500 (t 2 (let ((a 0)) 501 (map (cut + (begin (set! a (+ a 1)) a) <>) 502 '(1 2)) 503 a)) 504 (f (eval '((cut + <...> 1) 1))) 505 506 ;; Cute 507 (t '() ((cute list))) 508 (t '() ((cute list <...>))) 509 (t '(1) ((cute list 1))) 510 (t '(1) ((cute list <>) 1)) 511 (t '(1) ((cute list <...>) 1)) 512 (t '(1 2) ((cute list 1 2))) 513 (t '(1 2) ((cute list 1 <>) 2)) 514 (t '(1 2) ((cute list 1 <...>) 2)) 515 (t '(1 2 3 4) ((cute list 1 <...>) 2 3 4)) 516 (t '(1 2 3 4) ((cute list 1 <> 3 <>) 2 4)) 517 (t '(1 2 3 4 5 6) ((cute list 1 <> 3 <...>) 2 4 5 6)) 518 (t 1 (let ((a 0)) 519 (map (cute + (begin (set! a (+ a 1)) a) <>) 520 '(1 2)) 521 a)) 522 (f (eval '((cute + <...> 1) 1))) 523 No newline at end of file