conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixed fprintf line in scheme-script.c

This commit is contained in:
Abdulaziz Ghuloum 2008-12-23 20:41:12 -05:00
parent 0bd854dedf
commit 82b7edcf14
3 changed files with 23 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
scheme/ikarus.lists.ss
View File

@ -505,8 +505,7 @@
[(pair? d) [(pair? d)
(if ($fxzero? n) (if ($fxzero? n)
(die who "list was altered!") (die who "list was altered!")
(cons (f a) (cons (f a) (map1 f ($car d) ($cdr d) ($fxsub1 n))))]
(map1 f ($car d) ($cdr d) ($fxsub1 n))))]
[(null? d) [(null? d)
(if ($fxzero? n) (if ($fxzero? n)
(cons (f a) '()) (cons (f a) '())
@ -534,9 +533,8 @@
(cons (f a1 a2) '()) (cons (f a1 a2) '())
(die who "list was altered"))] (die who "list was altered"))]
[else [else
(die who (if (list? d2) (die who
"length mismatch" (if (list? d2) "length mismatch" "not a proper list"))])]
"not a proper list"))])]
[else (die who "list was altered")]))) [else (die who "list was altered")])))
(define cars (define cars
(lambda (ls*) (lambda (ls*)
@ -560,21 +558,26 @@
(cons (cdr a) (cdrs (cdr ls*)))] (cons (cdr a) (cdrs (cdr ls*)))]
[else [else
(die 'map "length mismatch")]))]))) (die 'map "length mismatch")]))])))
(define (err-mutated all-lists)
(apply die 'map "some lists were mutated during operation" all-lists))
(define (err-mismatch all-lists)
(apply die 'map "length mismatch" all-lists))
(define (err-invalid all-lists)
(apply die 'map "invalid arguments" all-lists))
(define mapm (define mapm
(lambda (f ls ls* n) (lambda (f ls ls* n all-lists)
(cond (cond
[(null? ls) [(null? ls)
(if (andmap null? ls*) (if (andmap null? ls*)
(if (fxzero? n) (if (fxzero? n)
'() '()
(die 'map "lists were mutated during operation")) (err-mutated all-lists))
(die 'map "length mismatch"))] (err-mismatch all-lists))]
[(fxzero? n) [(fxzero? n) (err-mutated all-lists)]
(die 'map "lists were mutated during operation")]
[else [else
(cons (cons
(apply f (car ls) (cars ls*)) (apply f (car ls) (cars ls*))
(mapm f (cdr ls) (cdrs ls*) (fxsub1 n)))]))) (mapm f (cdr ls) (cdrs ls*) (fxsub1 n) all-lists))])))
(define map (define map
(case-lambda (case-lambda
[(f ls) [(f ls)
@ -585,7 +588,7 @@
(let ([d ($cdr ls)]) (let ([d ($cdr ls)])
(map1 f ($car ls) d (len d d 0)))] (map1 f ($car ls) d (len d d 0)))]
[(null? ls) '()] [(null? ls) '()]
[else (die who "improper list")])] [else (err-invalid (list ls))])]
[(f ls ls2) [(f ls ls2)
(unless (procedure? f) (unless (procedure? f)
(die who "not a procedure" f)) (die who "not a procedure" f))
@ -594,30 +597,18 @@
(if (pair? ls2) (if (pair? ls2)
(let ([d ($cdr ls)]) (let ([d ($cdr ls)])
(map2 f ($car ls) ($car ls2) d ($cdr ls2) (len d d 0))) (map2 f ($car ls) ($car ls2) d ($cdr ls2) (len d d 0)))
(die who (err-invalid (list ls ls2)))]
(if (list? ls2) [(and (null? ls) (null? ls2)) '()]
"length mismatch" [else (err-invalid (list ls ls2))])]
"not a proper list")))]
[(null? ls)
(if (null? ls2)
'()
(die who
(if (list? ls2)
"length mismatch"
"not a proper list")))]
[else (die who "not a list")])]
[(f ls . ls*) [(f ls . ls*)
(unless (procedure? f) (unless (procedure? f)
(die who "not a procedure" f)) (die who "not a procedure" f))
(cond (cond
[(pair? ls) [(pair? ls)
(let ([n (len ls ls 0)]) (let ([n (len ls ls 0)])
(mapm f ls ls* n))] (mapm f ls ls* n (cons ls ls*)))]
[(null? ls) [(and (null? ls) (andmap null? ls*)) '()]
(if (andmap null? ls*) [else (err-invalid (cons ls ls*))])])))
'()
(die who "invalid arguments"))]
[else (die who "not a list" ls)])])))
(module (for-each) (module (for-each)
(define who 'for-each) (define who 'for-each)

2
scheme/last-revision
View File

@ -1 +1 @@
1720 1721

2
src/scheme-script.c
View File

@ -37,7 +37,7 @@ void ikarus_usage(){
arguments ... as (command-line)\n\ arguments ... as (command-line)\n\
\n\ \n\
Consult the Ikarus Scheme User's Guide for more details.\n\n"; Consult the Ikarus Scheme User's Guide for more details.\n\n";
fprintf(stderr, helpstring); fprintf(stderr, "%s", helpstring);
} }
int main(int argc, char** argv){ int main(int argc, char** argv){