Changeset 33876 in project
 Timestamp:
 03/04/17 18:23:26 (3 years ago)
 Location:
 release/4/lazylists
 Files:

 6 edited
 1 copied
Legend:
 Unmodified
 Added
 Removed

release/4/lazylists/tags/0.9/lazylists.scm
r31803 r33876 2 2 ; ju (at) jugilo (dot) de 3 3 ; 4 ; Copyright (c) 2012201 4, Juergen Lorenz, Moritz Heidkamp4 ; Copyright (c) 20122017, Juergen Lorenz 5 5 ; All rights reserved. 6 6 ; … … 31 31 ; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 32 32 ; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 ; 34 ; Last update: Nor 09, 2014 35 ; 33 34 #[ 35 The lazylist implementation of this module is inspired by Moritz 36 Heidkamp's lazyseq egg. It's not based on the Scheme primitives delay 37 and force, but uses a record type instead. I've added an additional slot 38 to this recordtype, a boolean, finite?, so that it is possible to 39 discriminate between finite and infinite lazy lists without realizing 40 the whole record. After all, some routines, reverse for example, make 41 only sense for finite lists. Moreover, the names of all exported 42 routines are capitalized, so that I could reuse the familiar names of 43 eager lists without fear of name clashes. 44 I followed a consistent argument order, at least in principle: List 45 arguments are always last, procedure arguments always first. Some well 46 known list primitives, Listref and Listtail, with wrong argument 47 order, are still there, but accompanied by At and Drop with the right 48 order. 49 ]# 50 36 51 (module lazylists 37 (lazylists Lazy assumeinMakelazy52 (lazylists assumein Lazy Makelazy 38 53 List>list list>List input>List 39 54 First Rest Car Cdr Length Lengthmin Append Reverse … … 41 56 Listinfinite? Realize 42 57 Listnotnull? Listfinite? Listsonefinite? 43 Take Drop Ref Takewhile Dropwhile Countwhile 58 At Ref Listref Listtail 59 Take Drop Takewhile Dropwhile Countwhile 44 60 Memp Member Memq Memv 45 61 Equ? Equal? Eq? Eqv? … … 57 73 (only datastructures o compress listof?) 58 74 (only chicken 59 condexpand60 75 definerecordtype 61 76 definerecordprinter 62 cut when caselambda 63 nthvalue unless receive 64 makeparameter error void add1 sub1 65 fixnum? fx+ fx= fx>= fx< fx fx/)) 66 77 definereaderctor 78 cut caselambda 79 unless receive 80 makeparameter error void 81 fixnum? fx+ fx= fx>= fx< fx> fx fx/ fxshr)) 82 83 ;; documentation procedure 67 84 (define lazylists 68 85 (let ( 69 86 (signatures '( 70 (Lazy len xpr . xprs)71 87 (assumein sym test . tests) 72 (Makelazy len thunk) 88 (Lazy finite? xpr . xprs) 89 (Makelazy finite? thunk) 73 90 (List>list Lstfinite) 74 91 (list>List lst) … … 103 120 (Take k Lst) 104 121 (Drop k Lst) 122 (Listtail Lst k) 105 123 (Ref k Lst) 124 (Listref Lst k) 125 (At k Lst) 106 126 (Takewhile ok? Lst) 107 127 (Dropwhile ok? Lst) … … 126 146 (Map fn . Lsts) 127 147 (Foreach proc . Lsts) 128 (Iterate [n] fn x)129 (Repeat [n] x)130 (Repeatedly [n] thunk)131 (Cycle [ n] Lst)148 (Iterate fn x [times]) 149 (Repeat x [times]) 150 (Repeatedly thunk [times]) 151 (Cycle [times] Lst) 132 152 (Range [from] upto [step]) 133 153 (Cardinals) … … 136 156 (Merge <? Lstfinite1 Lstfinite2) 137 157 (Sorted? <? Lstfinite) 138 (Foldright op base . Lstsonefinite)139 (Foldleft op base . Listsonefinite)140 (Foldright* op base . Lsts)141 (Foldleft* op base . Lsts)158 (Foldright op base Lst . Lsts) 159 (Foldleft op base Lst . Lsts) 160 (Foldright* op base Lst . Lsts) 161 (Foldleft* op base Lst . Lsts) 142 162 (Zip Lst1 Lst2) 143 163 (Unzip Lst) … … 179 199 (define lazylist 180 200 (definerecordtype lazylist 181 (makelazylist lengthbody value)201 (makelazylist finite? body value) 182 202 lazylist? 183 ( length lazylistlength lazylistlengthset!)203 (finite? lazylistfinite?) 184 204 (body lazylistbody lazylistbodyset!) 185 205 (value lazylistvalue lazylistvalueset!))) … … 187 207 (definesyntax Lazy 188 208 (syntaxrules () 189 ((_ lenxpr . xprs)190 (Makelazy len(lambda () xpr . xprs)))))191 192 193 (define (Makelazy lenthunk)194 (makelazylist lenthunk #f))209 ((_ finite? xpr . xprs) 210 (Makelazy finite? (lambda () xpr . xprs))))) 211 212 213 (define (Makelazy finite? thunk) 214 (makelazylist finite? thunk #f)) 195 215 196 216 (define (Cons var Lst) 197 217 (assumein 'Cons 198 218 (List? Lst)) 199 (let (( len (lazylistlengthLst)))200 (Lazy (if len (+ 1 len) #f)219 (let ((finite? (lazylistfinite? Lst))) 220 (Lazy finite? 201 221 (cons var Lst)))) 202 222 203 (define Length lazylistlength) 223 (define (Length Lst) 224 (assumein 'Length 225 (List? Lst)) 226 (if (lazylistfinite? Lst) 227 (let loop ((Lst Lst) (result 0)) 228 (if (Null? Lst) 229 result 230 (loop (Rest Lst) (fx+ 1 result)))) 231 #f)) 204 232 205 233 (define (Lengthmin . Lsts) 206 234 (assumein 'Lengthmin 207 235 ((listof? List?) Lsts)) 208 (let * ((lens (map Length Lsts))209 (finites (compress lens lens)))210 (if (null? finites)236 (let ((Finites (compress (map lazylistfinite? Lsts) 237 Lsts))) 238 (if (null? Finites) 211 239 #f 212 (apply min finites))))240 (apply min (map Length Finites))))) 213 241 214 242 (define List? lazylist?) 215 243 216 244 (define Nil 217 (makelazylist 0(lambda () '()) #f))245 (makelazylist #t (lambda () '()) #f)) 218 246 219 247 (definerecordprinter (lazylist Lst out) 220 248 (assumein 'definerecordprinter 221 249 (List? Lst)) 222 (display "#(List[" out) 223 (display (lazylistlength Lst) out) 250 (display "#,(List[" out) 251 (display (if (lazylistfinite? Lst) 252 "finite" 253 "infinite") out) 254 ;(display (lazylistfinite? Lst) out) 224 255 (display "]" out) 225 256 (cond ((not (Realized? Lst)) … … 254 285 (assumein 'Realize 255 286 (Listfinite? Lst)) 256 (let ((len (lazylistlength Lst))) 257 (when len 258 (Ref ( len 1) Lst) 259 Lst))) 287 ;(let ((len (Length Lst))) 288 ; (when len 289 ; (At (fx len 1) Lst) 290 ; Lst))) 291 (At (fx (Length Lst) 1) Lst) 292 Lst) 260 293 261 294 (define (Realized? Lst) … … 273 306 (car (realize Lst))) 274 307 275 (define (Car Lst) 276 (assumein 'Car 277 (List? Lst)) 278 (First Lst)) 279 280 ;; to speed up cdring for lists with preknown length 281 (define (rest Lst) 282 (assumein 'rest (List? Lst)) 283 (cdr (realize Lst))) 308 (define Car First) 284 309 285 310 (define (Rest Lst) 286 311 (assumein 'Rest (List? Lst)) 287 (let ( 288 (len (lazylistlength Lst)) 289 (Result (cdr (realize Lst))) 290 ) 291 (lazylistlengthset! Result (if len (fx len 1) #f)) 292 Result)) 293 294 (define (Cdr Lst) 295 (assumein 'Cdr (List? Lst)) 296 (Rest Lst)) 297 312 (cdr (realize Lst))) 313 314 (define Cdr Rest) 315 316 ;; deprecated 317 ;; makes finite Lists eager!!! 318 ;; and if checked traverses Lists twice 298 319 (define (Admissible? n Lst) 299 320 (assumein 'Admissible? … … 301 322 (fixnum? n) 302 323 (fx>= n 0)) 303 (let ((len ( lazylistlength Lst)))324 (let ((len (Length Lst)));(lazylistlength Lst))) 304 325 (or (not len) (fx< n len)))) 305 326 306 (define (Ref n Lst) 307 (assumein 'Ref 308 (Admissible? n Lst)) 309 (let ((len (lazylistlength Lst))) 310 (let loop ((n n) (Lst Lst)) 311 (if (fx= n 0) 312 (First Lst) 313 (loop (fx n 1) (Rest Lst)))))) 327 (define (At k Lst) 328 (assumein 'At 329 (List? Lst) (fx>= k 0)) 330 (cond 331 ((Null? Lst) 332 (error 'At "out of range" k Lst)) 333 ((fx= 0 k) 334 (First Lst)) 335 (else 336 (At (fx k 1) (Rest Lst))))) 337 338 ;; deprecated 339 (define Ref At) 340 341 (define (Listref Lst k) 342 (At k Lst)) 314 343 315 344 (define (List>list Lst) … … 328 357 (if (null? lst) 329 358 Lst 330 (loop (cdr lst) (Cons (car lst) Lst))))) 359 (loop (cdr lst) 360 (Lazy #t (cons (car lst) Lst)))))) 331 361 332 362 (define (List . args) 333 363 (list>List args)) 334 364 365 (definereaderctor 'List List) 366 367 ;; Drop and Take as well as Splitat now check n parameter 335 368 (define (Take n Lst) 336 369 (assumein 'Take … … 338 371 (fixnum? n) 339 372 (fx>= n 0)) 340 (callwithvalues 341 (lambda () (Splitat n Lst)) 342 (lambda (a b) a))) 343 373 (if (and (Null? Lst) (fx> n 0)) 374 (error 'Take "out of bounds" Lst n) 375 (Lazy #t 376 (if (or (fx= n 0) (Null? Lst)) 377 '() 378 (cons 379 (First Lst) 380 (Take (fx n 1) (Rest Lst))))))) 381 344 382 (define (Drop n Lst) 345 383 (assumein 'Drop 346 (Admissible? n Lst)) 347 (callwithvalues 348 (lambda () (Splitat n Lst)) 349 (lambda (a b) b))) 384 (List? Lst) 385 (fixnum? n) 386 (fx>= n 0)) 387 (cond 388 ((and (Null? Lst) (fx> n 0)) 389 (error 'Drop "out of bounds" Lst n)) 390 ((or (zero? n) (Null? Lst)) 391 Lst) 392 (else 393 (Drop (fx n 1) (Rest Lst))))) 394 395 (define (Listtail Lst n) 396 (Drop n Lst)) 397 398 (define (Splitat n Lst) 399 (values (Take n Lst) (Drop n Lst))) 350 400 351 401 (define (Takewhile ok? Lst) … … 353 403 (Listfinite? Lst) 354 404 (procedure? ok?)) 355 (nthvalue 0 (Splitwith ok? Lst))) 405 (let ((finite? (lazylistfinite? Lst))) 406 (let loop ((Lst Lst)) 407 (Lazy finite? 408 (cond 409 ((Null? Lst) 410 '()) 411 ((ok? (First Lst)) 412 (cons (First Lst) (loop (Rest Lst)))) 413 (else '())))))) 414 ; (Lazy (lazylistfinite? Lst) 415 ; (let loop ((Lst Lst)) 416 ; (cond 417 ; ((Null? Lst) 418 ; '()) 419 ; ((ok? (First Lst)) 420 ; (cons (First Lst) (loop (Rest Lst)))) 421 ; (else '()))))) 356 422 357 423 (define (Countwhile ok? Lst) … … 359 425 (Listfinite? Lst) 360 426 (procedure? ok?)) 361 (nthvalue 1 (Splitwith ok? Lst))) 427 (let loop ((Lst Lst) (index 0)) 428 (cond 429 ((Null? Lst) 430 index) 431 ((ok? (First Lst)) 432 (loop (Rest Lst) (fx+ index 1))) 433 (else index)))) 362 434 363 435 (define (Dropwhile ok? Lst) … … 365 437 (Listfinite? Lst) 366 438 (procedure? ok?)) 367 (nthvalue 2 (Splitwith ok? Lst))) 439 (let ((finite? (lazylistfinite? Lst))) 440 (let loop ((Lst Lst)) 441 (Lazy finite? 442 (cond 443 ((Null? Lst) 444 '()) 445 ((ok? (First Lst)) 446 (loop (Rest Lst))) 447 (else Lst)))))) 448 449 (define (Splitwith ok? Lst) 450 (values (Takewhile ok? Lst) 451 (Countwhile ok? Lst) 452 (Dropwhile ok? Lst))) 368 453 369 454 (define (Memp ok? Lst) … … 374 459 375 460 (define (Memq var Lst) 376 (assumein 'Memq377 (Listfinite? Lst))461 ;(assumein 'Memq 462 ; (Listfinite? Lst)) 378 463 (Memp (cut eq? <> var) Lst)) 379 464 380 465 (define (Memv var Lst) 381 (assumein 'Memv382 (Listfinite? Lst))466 ;(assumein 'Memv 467 ; (Listfinite? Lst)) 383 468 (Memp (cut eqv? <> var) Lst)) 384 469 385 470 (define (Member var Lst) 386 (assumein 'Member387 (Listfinite? Lst))471 ;(assumein 'Member 472 ; (Listfinite? Lst)) 388 473 (Memp (cut equal? <> var) Lst)) 389 474 … … 393 478 (List? Lst1) 394 479 (List? Lst2)) 395 (if (eqv? (lazylistlength Lst1) (lazylistlength Lst2)) 396 (if (lazylistlength Lst1) 397 ;; both finite 398 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 399 (cond 400 ((Null? Lst1) #t) 401 ((=? (First Lst1) (First Lst2)) 402 (loop (Rest Lst1) (Rest Lst2))))) 403 ;; both infinite 404 (eq? Lst1 Lst2)) 405 #f)) 480 (cond 481 ((and (Listfinite? Lst1) (Listfinite? Lst2)) 482 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 483 (cond 484 ((and (Null? Lst1) (Null? Lst2)) 485 #t) 486 ((=? (First Lst1) (First Lst2)) 487 (loop (Rest Lst1) (Rest Lst2))) 488 (else #f)))) 489 ((and (Listinfinite? Lst1) (Listinfinite? Lst2)) 490 (eq? Lst1 Lst2)) 491 (else #f))) 406 492 407 493 (define (Eq? Lst1 Lst2) 408 (assumein 'Eq?409 (List? Lst1)410 (List? Lst2))494 ;(assumein 'Eq? 495 ; (List? Lst1) 496 ; (List? Lst2)) 411 497 (Equ? eq? Lst1 Lst2)) 412 498 413 499 (define (Eqv? Lst1 Lst2) 414 (assumein 'Eqv?415 (List? Lst1)416 (List? Lst2))500 ;(assumein 'Eqv? 501 ; (List? Lst1) 502 ; (List? Lst2)) 417 503 (Equ? eqv? Lst1 Lst2)) 418 504 419 505 (define (Equal? Lst1 Lst2) 420 (assumein 'Equal?421 (List? Lst1)422 (List? Lst2))506 ;(assumein 'Equal? 507 ; (List? Lst1) 508 ; (List? Lst2)) 423 509 (Equ? equal? Lst1 Lst2)) 424 510 … … 433 519 434 520 (define (Assq key al) 435 (assumein 'Assq 436 (symbol? key) 437 ((listof? pair?) al)) 521 ;(assumein 'Assq 522 ; ((listof? pair?) al)) 438 523 (Assp (cut eq? <> key) al)) 439 524 440 525 (define (Assv key al) 441 (assumein 'Assv442 ((listof? pair?) al))526 ;(assumein 'Assv 527 ; ((listof? pair?) al)) 443 528 (Assp (cut eqv? <> key) al)) 444 529 445 530 (define (Assoc key al) 446 (assumein 'Assoc447 ((listof? pair?) al))531 ;(assumein 'Assoc 532 ; ((listof? pair?) al)) 448 533 (Assp (cut equal? <> key) al)) 449 534 … … 463 548 (if (null? Lsts) 464 549 Nil 465 (let loop ((Lsts Lsts)) 466 (Lazy (apply Lengthmin Lsts) 467 (if (memp Null? Lsts) 468 '() 469 (cons (apply proc (map Car Lsts)) 470 (loop (map Cdr Lsts)))))))) 550 (let ((finite? (if (not (apply Lengthmin Lsts)) #f #t))) 551 (let loop ((Lsts Lsts)) 552 (Lazy finite? 553 (if (memp Null? Lsts) 554 '() 555 (cons (apply proc (map Car Lsts)) 556 (loop (map Cdr Lsts))))))))) 471 557 472 558 (define (Foreach proc . Lsts) … … 485 571 (List? Lst)) 486 572 (let ((ev? #f)) 487 (let loop ((Lst Lst)) 488 (cond 489 ((Null? Lst) 490 (values Nil Nil)) 491 (else 492 (set! ev? (not ev?)) 493 (if (lazylistlength Lst) 494 ;; compute new length via Cons 573 (let ((finite? (lazylistfinite? Lst))) 574 (let loop ((Lst Lst)) 575 (cond 576 ((Null? Lst) 577 (values Nil Nil)) 578 (else 579 (set! ev? (not ev?)) 495 580 (if ev? 496 (values (Cons (First Lst) (loop (Rest Lst))) 497 (loop (Rest Lst))) 498 (values (loop (Rest Lst)) 499 (Cons (First Lst) (loop (Rest Lst))))) 500 ;; set new length #f 501 (if ev? 502 (values (Lazy #f (cons (First Lst) (loop (rest Lst)))) 503 (Lazy #f (loop (rest Lst)))) 504 (values (Lazy #f (loop (rest Lst))) 505 (Lazy #f (cons (First Lst) (loop (rest Lst)))))))))))) 581 (values (Lazy finite? 582 (cons (First Lst) (loop (Rest Lst)))) 583 (Lazy finite? 584 (loop (Rest Lst)))) 585 (values (Lazy finite? 586 (loop (Rest Lst))) 587 (Lazy finite? 588 (cons (First Lst) (loop (Rest Lst)))))))))))) 506 589 507 590 (define (Zip Lst1 Lst2) … … 509 592 (List? Lst1) 510 593 (List? Lst2)) 511 ( if (Null? Lst1)512 Lst2513 (if (and (lazylistlength Lst1) (lazylistlength Lst2))514 ;; both finite, compute new length with Cons515 ( Cons (First Lst1) (Zip Lst2 (Rest Lst1)))516 ;; new length infinite517 (Lazy #f518 (cons (First Lst1) (Zip Lst2 (Rest Lst1)))))))594 (let ((bothfinite? 595 (and (lazylistfinite? Lst1) 596 (lazylistfinite? Lst2)))) 597 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 598 (if (Null? Lst1) 599 Lst2 600 (Lazy bothfinite? 601 (cons (First Lst1) (loop Lst2 (Rest Lst1)))))))) 519 602 520 603 (define (Filter ok? Lst) 521 604 (assumein 'Filter 522 (List? Lst)) 523 (let loop ((Lst Lst)) 524 (if (Null? Lst) 525 Nil 526 (let ((first (First Lst)) 527 (Result (if (lazylistlength Lst) 528 (loop (Rest Lst)) 529 (Lazy #f (loop (rest Lst)))))) 530 (if (ok? first) 531 (Cons first Result) 532 Result))))) 533 ; (if (Null? Lst) 534 ; (values Nil Nil) 535 ; (let ((first (First Lst))) 536 ; (if (lazylistlength Lst) 537 ; (receive (Yes No) (Filter ok? (Rest Lst)) 538 ; (if (ok? first) 539 ; (values (Cons first Yes) No) 540 ; (values Yes (Cons first No)))) 541 ; (let ((yes (Lazy #f (Filter ok? (rest Lst)))) 542 ; (no (Lazy #f (Filter (o not ok?) (rest Lst))))) 543 ; ;(receive (yes no) (Filter ok? (rest Lst)) ; wrong 544 ; (if (ok? first) 545 ; (values (Cons first yes) no) 546 ; (values yes (Cons first no)))))))) 605 (List? Lst) 606 (procedure? ok?)) 607 (let ((finite? (lazylistfinite? Lst))) 608 (let loop ((Lst Lst)) 609 (Lazy finite? 610 (if (Null? Lst) 611 '() 612 (let ((first (First Lst)) (rest (Rest Lst))) 613 (if (ok? first) 614 (cons first (loop rest)) 615 (loop rest)))))))) 547 616 548 617 (define (Remp ok? Lst) … … 560 629 (define (input>List port read) 561 630 (let loop () 562 ;(Lazy #f631 (Lazy #f 563 632 (let ((datum (read port))) 564 633 (if (eofobject? datum) 565 Nil566 ( Cons datum (loop))))));)634 '() 635 (cons datum (loop))))))) 567 636 568 637 (define Repeat 569 638 (caselambda 570 639 ((x) (Lazy #f (cons x (Repeat x)))) 571 (( n x)640 ((x times) 572 641 (assumein 'Repeat 573 (fixnum? n)574 (fx>= n0))575 (Take n(Repeat x)))))642 (fixnum? times) 643 (fx>= times 0)) 644 (Take times (Repeat x))))) 576 645 577 646 (define Repeatedly … … 581 650 (procedure? thunk)) 582 651 (Lazy #f (cons (thunk) (Repeatedly thunk)))) 583 (( n thunk)652 ((thunk times) 584 653 (assumein 'Repeatedly 585 (procedure? thunk) 586 (fixnum? n) 587 (fx>= n 0)) 588 (Take n (Repeatedly thunk))))) 654 (fixnum? times) 655 (fx>= times 0)) 656 (Take times (Repeatedly thunk))))) 589 657 590 658 (define Iterate 591 659 (caselambda 592 ((f x)660 ((fn x) 593 661 (assumein 'Iterate 594 (procedure? f ))595 (Lazy #f (cons x (Iterate f (fx)))))596 (( n f x)662 (procedure? fn)) 663 (Lazy #f (cons x (Iterate fn (fn x))))) 664 ((fn x times) 597 665 (assumein 'Iterate 598 (procedure? f) 599 (fixnum? n) 600 (fx>= n 0)) 601 (Take n (Iterate f x))))) 666 (fixnum? times) 667 (fx>= times 0)) 668 (Take times (Iterate fn x))))) 602 669 603 670 (define Cycle … … 613 680 (loop Lst) 614 681 (cons (First tail) 615 (loop ( rest tail))))))))682 (loop (Rest tail)))))))) 616 683 ((n Lst) 617 684 (assumein 'Cycle 618 (List? Lst)619 685 (fixnum? n) 620 686 (fx>= n 0)) … … 624 690 (caselambda 625 691 ((upto) 626 (Iterate (abs upto) 627 (if (fx>= upto 0) 692 (Iterate (if (fx>= upto 0) 628 693 (cut fx+ <> 1) 629 694 (cut fx <> 1)) 630 0)) 695 0 696 (abs upto))) 631 697 ((from upto) 632 (Iterate (abs (fx upto from)) 633 (if (fx>= upto from) 698 (Iterate (if (fx>= upto from) 634 699 (cut fx+ <> 1) 635 700 (cut fx <> 1)) 636 from)) 701 from 702 (abs (fx upto from)) 703 )) 637 704 ((from upto step) 638 (Iterate (fx/ (fx+ (fx step 1) (abs (fx upto from))) step) 639 (if (fx>= upto from) 705 (Iterate (if (fx>= upto from) 640 706 (cut fx+ <> step) 641 707 (cut fx <> step)) 642 from)))) 643 644 (define (Append2 Lst1 Lst2) 645 (if (not (lazylistlength Lst1)) 646 Lst1 647 (let loop ((Lst Lst1)) 648 (Lazy (if (lazylistlength Lst2) 649 (+ (lazylistlength Lst1) 650 (lazylistlength Lst2)) 651 #f) 652 (if (Null? Lst) 653 Lst2 654 (cons (First Lst) (loop (rest Lst)))))))) 655 656 (define (Append . Lsts) 657 (assumein 'Append 658 ((listof? Listfinite?) (butlast Lsts)) 659 (List? (last Lsts))) 660 (cond 661 ((null? Lsts) Nil) 662 ((null? (cdr Lsts)) (car Lsts)) 663 (else 664 (Append2 (car Lsts) (apply Append (cdr Lsts)))))) 665 666 (define (Reverse Lst) 667 (assumein 'Reverse 668 (Listfinite? Lst)) 669 (let loop ((Lst Lst) (reverse Nil)) 670 (if (Null? Lst) 671 reverse 672 (Lazy (lazylistlength Lst) 673 (loop (rest Lst) 674 (Cons (First Lst) reverse)))))) 708 from 709 (fx/ (fx+ (fx step 1) (abs (fx upto from))) step) 710 )))) 711 712 (define Append 713 (caselambda 714 ((Lst1 Lst2) 715 (assumein 'Append 716 (List? Lst1) (List? Lst2)) 717 (if (Listinfinite? Lst1) 718 Lst1 719 (let ((finite? (lazylistfinite? Lst2))) 720 (let loop ((Lst1 Lst1)) 721 (Lazy finite? 722 (if (Null? Lst1) 723 Lst2 724 (cons (First Lst1) (loop (Rest Lst1))))))))) 725 ((Lst . Lsts) 726 (if(Null? Lsts) 727 Lst 728 (apply Append 729 (Append Lst (First Lsts)) 730 (Rest Lsts)))) 731 )) 732 733 (define Reverse 734 (caselambda 735 ((Lst1 Lst2) 736 (assumein 'Reverse 737 (Listfinite? Lst1) (List? Lst2)) 738 (let ((finite? (lazylistfinite? Lst2))) 739 (let loop ((Lst1 Lst1) (Result Lst2)) 740 (if (Null? Lst1) 741 Result 742 (loop (Rest Lst1) 743 (Lazy finite? 744 (cons (First Lst1) Result))))))) 745 ((Lst) 746 (Reverse Lst Nil)))) 675 747 676 748 (define (Reverse* Lst) 677 749 (assumein 'Reverse* 678 750 (List? Lst)) 679 (letrec ( 680 (result 681 (Cons Nil 682 (Map Cons 683 Lst 684 (Lazy (lazylistlength Lst) result)))) 685 ) 686 (Rest result))) 751 (let ((finite? (lazylistfinite? Lst))) 752 (if (not finite?) 753 (let loop ((n 1)) 754 (Lazy #f (cons (Reverse (Take n Lst)) 755 (loop (fx+ n 1))))) 756 (let ((len (Length Lst))) 757 (let loop ((n 1)) 758 (Lazy #t 759 (if (fx= 0 len) 760 (list (First Lst)) 761 (cons (Reverse (Take n Lst)) 762 (loop (fx+ n 1)))))))))) 687 763 688 764 (define (Merge <? Lst1 Lst2) … … 691 767 (Listfinite? Lst1) 692 768 (Listfinite? Lst2)) 693 (let ((len (+ (lazylistlength Lst1) (lazylistlength Lst2))))694 ( let loop ((Lst1 Lst1) (Lst2 Lst2))695 ( cond696 ((Null? Lst1) Lst2)697 ((Null? Lst2) Lst1)698 ((<? (First Lst1) (First Lst2))699 ( Lazy len (cons (First Lst1) (loop (rest Lst1) Lst2))))700 701 (Lazy len702 (cons (First Lst2) (loop Lst1 (rest Lst2)))))))))769 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 770 (cond 771 ((Null? Lst1) Lst2) 772 ((Null? Lst2) Lst1) 773 ((<? (First Lst1) (First Lst2)) 774 (Lazy #t 775 (cons (First Lst1) (loop (Rest Lst1) Lst2)))) 776 (else 777 (Lazy #t 778 (cons (First Lst2) (loop Lst1 (Rest Lst2)))))))) 703 779 704 780 (define (Sort <? Lst) … … 706 782 (procedure? <?) 707 783 (Listfinite? Lst)) 708 (let ((len ( lazylistlength Lst)))709 (if ( < len 2)784 (let ((len (Length Lst))) 785 (if (fx< len 2) 710 786 Lst 711 (let ((halflen ( quotient len 2)))787 (let ((halflen (fxshr len 1))) 712 788 (Merge <? 713 789 (Sort <? (Take halflen Lst)) … … 721 797 (cond 722 798 ((Null? Lst) #t) 723 ((Null? ( CdrLst)) #t)724 ((<? ( Car Lst) (Car (CdrLst)))725 (loop ( CdrLst)))799 ((Null? (Rest Lst)) #t) 800 ((<? (First Lst) (First (Rest Lst))) 801 (loop (Rest Lst))) 726 802 (else #f)))) 727 803 … … 729 805 (assumein 'vector>List 730 806 (vector? vec)) 731 (let loop ((res Nil) (n (vectorlength vec))) 732 (if (zero? n) 733 res 734 (loop (Cons (vectorref vec ( n 1)) res) ( n 1))))) 735 736 ;; see comment to List>list 807 (let loop ((Result Nil) (n (fx (vectorlength vec) 1))) 808 (if (fx< n 0) 809 Result 810 (loop (Lazy #t (cons (vectorref vec n) Result)) 811 (fx n 1))))) 737 812 (define (List>vector Lst) 738 813 (assumein 'List>vector 739 814 (Listfinite? Lst)) 740 (let ((vec (makevector (lazylistlength Lst) #f))) 741 (let loop ((k 0) (Lst Lst)) 742 (cond 743 ((Null? Lst) 744 vec) 745 (else 746 (vectorset! vec k (First Lst)) 747 (loop (+ k 1) (rest Lst))))))) 748 749 (define (Splitat n Lst) 750 (assumein 'Splitat 751 (Admissible? n Lst)) 752 (let loop ((n n) (head Nil) (tail Lst)) 753 (if (or (Null? tail) (zero? n)) 754 (values (Reverse head) tail) 755 (loop ( n 1) 756 (Cons (First tail) head) 757 (Rest tail))))) 758 759 (define (Splitwith ok? Lst) 760 (assumein 'Splitwith 761 (procedure? ok?) 762 (Listfinite? Lst)) 763 (let loop ((head Nil) (index 0) (tail Lst)) 764 (if (or (Null? tail) (not (ok? (First tail)))) 765 ;(if (or (Null? tail) (ok? (First tail))) 766 (values (Reverse head) index tail) 767 (loop (Cons (First tail) head) 768 (+ index 1) 769 (Rest tail))))) 815 (let* ((len (Length Lst)) (vec (makevector len #f))) 816 (do ((k 0 (fx+ k 1)) (Lst Lst (Rest Lst))) 817 ((fx= k len) vec) 818 (vectorset! vec k (First Lst))))) 770 819 771 820 (define (Sieve =? Lst) … … 773 822 (procedure? =?) 774 823 (List? Lst)) 775 (let loop ((Lst Lst)) 776 (if (Null? Lst) 777 Nil 778 (let ( 779 (first (First Lst)) 780 (tail 781 (Filter 782 (lambda (x) 783 (not (=? x (First Lst)))) 784 (Rest Lst))) 785 ) 786 (if (lazylistlength Lst) 787 (Cons first (loop tail)) 788 (Lazy #f 789 (cons first (loop tail)))))))) 790 791 (define (Foldleft op base . Lsts) 824 (let ((finite? (lazylistfinite? Lst))) 825 (let loop ((Lst Lst)) 826 (Lazy finite? 827 (if (Null? Lst) 828 '() 829 (let ( 830 (first (First Lst)) 831 (rest 832 (Filter 833 (lambda (x) 834 (not (=? x (First Lst)))) 835 (Rest Lst))) 836 ) 837 (cons first (loop rest)))))))) 838 839 (define (Foldleft op base Lst . Lsts) 792 840 (assumein 'Foldleft 793 841 (procedure? op) 794 ( apply Listsonefinite? Lsts))795 (let loop ((base base)796 (Lsts Lsts)797 (len (apply Lengthmin Lsts)))798 (if (zero?len)799 base800 (loop (apply op base (map First Lsts))801 (map Rest Lsts)802 (fx len 1)))))803 804 (define (Foldright op base . Lsts)842 (List? Lst) 843 (or (Listfinite? Lst) (apply Listsonefinite? Lsts))) 844 (let* ((Lsts (cons Lst Lsts)) (len (apply Lengthmin Lsts))) 845 (let loop ((Lsts Lsts) (k 0) (result base)) 846 (if (fx= k len) 847 result 848 (loop (map Cdr Lsts) 849 (fx+ k 1) 850 (apply op result (map Car Lsts))))))) 851 852 (define (Foldright op base Lst . Lsts) 805 853 (assumein 'Foldright 806 854 (procedure? op) 807 (apply Listsonefinite? Lsts)) 808 (let loop ((Lsts Lsts) 809 (len (apply Lengthmin Lsts))) 810 (if (zero? len) 811 base 812 (apply op 813 (append (map First Lsts) 814 (list (loop (map Rest Lsts) (fx len 1)))))))) 855 (List? Lst) 856 (or (Listfinite? Lst) (apply Listsonefinite? Lsts))) 857 (let* ((Lsts (cons Lst Lsts)) (len (apply Lengthmin Lsts))) 858 (let loop ((Lsts Lsts) (len len)) 859 (if (fx= 0 len) 860 base 861 (apply op 862 (append (map First Lsts) 863 (list (loop (map Rest Lsts) (fx len 1))))))))) 815 864 816 865 ;;; The following two routines return Lists 817 (define (Foldleft* op base . Lsts)866 (define (Foldleft* op base Lst . Lsts) 818 867 (assumein 'Foldleft* 819 868 (procedure? op) 869 (List? Lst) 820 870 ((listof? List?) Lsts)) 821 (letrec ( 822 (fold 823 (Cons base 824 (apply Map op 825 (Lazy (apply Lengthmin Lsts) fold) 826 Lsts))) 827 ) 828 (Rest fold))) 829 830 (define (Foldright* op base . Lsts) ; changes order of List items 871 (let* ((Lsts (cons Lst Lsts)) 872 (finite? (if (not (apply Lengthmin Lsts)) 873 #f 874 #t))) 875 (letrec ( 876 (fold 877 (Lazy finite? 878 (cons base 879 (apply Map op 880 (Lazy finite? fold) 881 Lsts)))) 882 ) 883 (Rest fold)))) 884 885 (define (Foldright* op base Lst . Lsts) ; changes order of List items 831 886 (assumein 'Foldright* 832 887 (procedure? op) 888 (List? Lst) 833 889 ((listof? List?) Lsts)) 834 (letrec ( 835 (fold 836 (Cons base 837 (apply Map op 838 (append Lsts 839 (list 840 (Lazy (apply Lengthmin Lsts) fold)))))) 841 ) 842 (Rest fold))) 890 (let* ((Lsts (cons Lst Lsts)) 891 (finite? (if (not (apply Lengthmin Lsts)) 892 #f 893 #t))) 894 (letrec ( 895 (fold 896 (Lazy finite? 897 (cons base 898 (apply Map op 899 (append Lsts 900 (list 901 (Lazy finite? fold))))))) 902 ) 903 (Rest fold)))) 843 904 844 905 (define (Every? ok? Lst) … … 869 930 870 931 (define (Listfinite? xpr) 871 (and (List? xpr) (if (Length xpr) #t #f))) 932 (and (List? xpr) ; (if (Length xpr) #t #f))) 933 (lazylistfinite? xpr))) 872 934 873 935 (define (Listinfinite? xpr) 874 (and (List? xpr) (if (Length xpr) #f #t))) 936 (and (List? xpr) ;(if (Length xpr) #f #t))) 937 (not (lazylistfinite? xpr)))) 875 938 876 939 (define (Listsonefinite? . Lsts) … … 878 941 (not (null? Lsts)) 879 942 ((listof? List?) Lsts)) 880 (if (apply Lengthmin Lsts) #t #f)) 943 ;(if (apply Lengthmin Lsts) #t #f)) 944 (not (null? (compress (map lazylistfinite? Lsts) 945 Lsts)))) 881 946 882 947 ;;; two examples 
release/4/lazylists/tags/0.9/lazylists.setup
r31803 r33876 8 8 'lazylists 9 9 '("lazylists.so" "lazylists.import.so") 10 '((version "0. 8.1")))10 '((version "0.9"))) 
release/4/lazylists/tags/0.9/tests/run.scm
r31797 r33876 1 (requirelibrary lazylists simpletests)1 (requirelibrary simpletests lazylists) 2 2 (import lazylists simpletests) 3 3 (registerfeature! 'assumptionschecked) … … 5 5 (definetest (lazylist) 6 6 (check 7 (define (consright var lst)8 (if (null? lst)9 (cons var lst)10 (cons (car lst) (consright var (cdr lst)))))11 7 (define (Firstfive) (List 0 1 2 3 4)) 12 8 (define (Fibs) … … 26 22 (= (Length (Firstfive)) 5) 27 23 (= (Length (Rest (Firstfive))) 4) 28 ( eq? (Length (Rest (Cardinals))) #f)24 (not (Length (Rest (Cardinals)))) 29 25 (= (Length (Take 5 (Cardinals))) 5) 30 ( eq? (Length (Cardinals)) #f)31 ( eq? (Length (Drop 5 (Cardinals))) #f)26 (not (Length (Cardinals))) 27 (not (Length (Drop 5 (Cardinals)))) 32 28 (= (First (Drop 5 (Cardinals))) 5) 33 ( equal? (List>list (Firstfive)) '(0 1 2 3 4))34 ( equal? (List>list (Take 5 (Cardinals))) '(0 1 2 3 4))29 (Eqv? (Firstfive) (List 0 1 2 3 4)) 30 (Eqv? (Take 5 (Cardinals)) (List 0 1 2 3 4)) 35 31 (= (Length (Range 2 10)) ( 10 2)) 36 32 (= (Length (Range 10)) 10) 37 33 (= (Length (Range 1 10 2)) 6) 38 (equal? (List>list (Range 1 10 2)) '(1 1 3 5 7 9)) 39 (equal? (List>list (Range 2 10)) '(2 3 4 5 6 7 8 9)) 40 (equal? (List>list (Range 10 2)) '(10 9 8 7 6 5 4 3)) 34 (Eqv? (Range 1 10 2) (List 1 1 3 5 7 9)) 35 (Eqv? (Range 2 10) (List 2 3 4 5 6 7 8 9)) 36 (Eqv? (Range 10 2) (List 10 9 8 7 6 5 4 3)) 37 (Eqv? (Dropwhile (cut < <> 3) (Firstfive)) 38 (List 3 4)) 39 (Eqv? (Takewhile (cut < <> 3) (Firstfive)) 40 (List 0 1 2)) 41 41 (equal? 42 42 (receive (head index tail) (Splitwith (cut < <> 3) (Firstfive)) … … 49 49 (= (Countwhile (cut < <> 2) (Firstfive)) 2) 50 50 (= (Countwhile (cut < <> 20) (Firstfive)) 5) 51 ( equal? (List>list (Takewhile (cut < <> 5) (Take 10 (Cardinals))))52 '(0 1 2 3 4))51 (Eqv? (Takewhile (cut < <> 5) (Take 10 (Cardinals))) 52 (List 0 1 2 3 4)) 53 53 (= (Length (Takewhile (cut < <> 5) (Take 10 (Cardinals)))) 5) 54 54 (= (Length (Dropwhile (cut < <> 5) (Take 10 (Cardinals)))) 5) … … 56 56 (= (Length (Dropwhile (cut < <> 2) (Firstfive))) 3) 57 57 (= (First (Dropwhile (cut < <> 2) (Firstfive))) 2) 58 ( equal? (List>list (Memp odd? (Firstfive))) '(1 2 3 4))59 ( equal? (List>list (Memv 5 (Take 10 (Cardinals)))) '(5 6 7 8 9))58 (Eqv? (Memp odd? (Firstfive)) (List 1 2 3 4)) 59 (Eqv? (Memv 5 (Take 10 (Cardinals))) (List 5 6 7 8 9)) 60 60 (equal? (Assv 5 (Take 10 (Map (lambda (x) (list x x)) (Cardinals)))) 61 61 '(5 5)) 62 (eq? (Assv 10 (Map (lambda (x) (list x x)) (Firstfive))) #f) 63 (eq? (Equal? (Cardinals) (Cardinals)) #f) 64 (eq? (Equal? (Cardinals) (Firstfive)) #f) 65 (eq? (Equal? (Firstfive) (Firstfive)) #t) 62 (not (Assv 10 (Map (lambda (x) (list x x)) (Firstfive)))) 63 (not (Equal? (Cardinals) (Cardinals))) 64 (let ((Card (Cardinals))) 65 (Equal? Card Card)) 66 (not (Equal? (Cardinals) (Firstfive))) 67 (Equal? (Firstfive) (Firstfive)) 66 68 (= (Length (Take 10 (Cardinals))) 10) 67 ( equal? (List>list (Take 5 (Filter odd? (Drop 1 (Cardinals)))))68 '(1 3 5 7 9))69 (Eqv? (Take 5 (Filter odd? (Drop 1 (Cardinals)))) 70 (List 1 3 5 7 9)) 69 71 (Eqv? (Remp odd? (Firstfive)) (List 0 2 4)) 70 72 (Eqv? (Take 5 (Remp odd? (Cardinals))) 71 73 (Take 5 (Map (cut * <> 2) (Cardinals)))) 72 74 (Eqv? (Remv 3 (Firstfive)) (List 0 1 2 4)) 73 ( eq? (Length (Cardinals)) #f)74 ( equal? (List>list (Map add1 (Firstfive))) '(1 2 3 4 5))75 ( equal? (List>list (Map + (Firstfive) (Take 5 (Cardinals))))76 '(0 2 4 6 8))77 ( eq? (Length (Map + (Cardinals) (Cardinals))) #f)75 (not (Length (Cardinals))) 76 (Eqv? (Map add1 (Firstfive)) (List 1 2 3 4 5)) 77 (Eqv? (Map + (Firstfive) (Take 5 (Cardinals))) 78 (List 0 2 4 6 8)) 79 (not (Length (Map + (Cardinals) (Cardinals)))) 78 80 (Foreach (lambda (x y) (print "### " x " " y)) (Cardinals) (Firstfive)) 79 81 (= (Length (Filter odd? (Firstfive))) 2) 80 (equal? (List>list (Filter odd? (Firstfive))) '(1 3)) 81 (eq? (Length (Filter odd? (Cardinals))) #f) 82 (= (Ref 20 (Sieve = (Zip (Cardinals) (Cardinals)))) 20) 83 (equal? (List>list (Sieve = (Zip (Firstfive) (Firstfive)))) 84 '(0 1 2 3 4)) 85 (= (Ref 25 (Cardinals)) 25) 86 (= (Ref 2 (Firstfive)) 2) 87 (equal? (List>list (Repeat 3 #f)) '(#f #f #f)) 82 (Eqv? (Filter odd? (Firstfive)) (List 1 3)) 83 (not (Length (Filter odd? (Cardinals)))) 84 (Eqv? (Take 10 (Zip (Firstfive) (Cardinals))) 85 (List 0 0 1 1 2 2 3 3 4 4)) 86 (not (Length (Zip (Firstfive) (Cardinals)))) 87 (= (At 20 (Sieve = (Zip (Cardinals) (Cardinals)))) 20) 88 (Eqv? (Sieve = (Zip (Firstfive) (Firstfive))) 89 (List 0 1 2 3 4)) 90 (= (At 25 (Cardinals)) 25) 91 (= (At 2 (Firstfive)) 2) 92 (Eq? (Repeat #f 3) (List #f #f #f)) 88 93 (Listinfinite? (Repeatedly (lambda () 1))) 89 ( equal? (List>list (Repeatedly 3 (lambda () 1)))90 '(1 1 1))94 (Eqv? (Repeatedly (lambda () 1) 3) 95 (List 1 1 1)) 91 96 (Listinfinite? (Iterate add1 0)) 92 (Listfinite? (Iterate 3 add1 0))93 ( equal? (List>list (Iterate 3 add1 0)) '(0 1 2))94 ( eq? (Length (Iterate add1 0)) #f)95 ( equal? (List>list (Cycle 10 (Firstfive)))96 '(0 1 2 3 4 0 1 2 3 4))97 ( eq? (Length (Cycle (Firstfive))) #f)97 (Listfinite? (Iterate add1 0 3)) 98 (Eqv? (Iterate add1 0 3) (List 0 1 2)) 99 (not (Length (Iterate add1 0))) 100 (Eqv? (Cycle 10 (Firstfive)) 101 (List 0 1 2 3 4 0 1 2 3 4)) 102 (not (Length (Cycle (Firstfive)))) 98 103 (= (Length (Append (Firstfive) (Firstfive))) 10) 99 104 (not (Length (Append (Cardinals) (Firstfive)))) 100 (equal? (List>list (Append (Firstfive) (Firstfive))) 101 '(0 1 2 3 4 0 1 2 3 4)) 102 (equal? (List>list (Take 12 (Append (Firstfive) (Cardinals)))) 103 '(0 1 2 3 4 0 1 2 3 4 5 6)) 104 (eq? (Length (Append (Firstfive) (Cardinals))) #f) 105 (equal? (List>list (Reverse (Firstfive))) '(4 3 2 1 0)) 106 (equal? (List>list (Reverse (Take 5 (Cardinals)))) '(4 3 2 1 0)) 105 (Eqv? (Append (Firstfive) (Firstfive)) 106 (List 0 1 2 3 4 0 1 2 3 4)) 107 (Eqv? (Take 12 (Append (Firstfive) (Cardinals))) 108 (List 0 1 2 3 4 0 1 2 3 4 5 6)) 109 (not (Length (Append (Firstfive) (Cardinals)))) 110 (Listfinite? (Reverse (Firstfive))) 111 (Listfinite? Nil) 112 (zero? (Length Nil)) 113 (Equ? = (Reverse (Firstfive)) (List 4 3 2 1 0)) 114 (Equ? = (Reverse (Take 5 (Cardinals))) (List 4 3 2 1 0)) 115 (= (Length (List 0 1 2 3 4)) 5) 107 116 (= (Length (Reverse (Firstfive))) 5) 108 ( eq? (Length (Reverse* (Cardinals))) #f)109 ( equal? (List>list (Ref 5 (Reverse* (Cardinals)))) '(5 4 3 2 1 0))110 ( equal? (List>list (Sort < (Firstfive))) '(0 1 2 3 4))117 (not (Length (Reverse* (Cardinals)))) 118 (Equal? (At 5 (Reverse* (Cardinals))) (List 5 4 3 2 1 0)) 119 (Equal? (At 4 (Reverse* (Firstfive))) (List 4 3 2 1 0)) 111 120 (Sorted? < (Firstfive)) 112 121 (not (Sorted? < (Append (Firstfive) (Firstfive)))) 122 (Equal? (Sort < (Firstfive)) (List 0 1 2 3 4)) 113 123 (= (Length (Sort < (Firstfive))) 5) 114 ( equal? (List>list (Sort < (List 3 1 0 2 4))) '(0 1 2 3 4))124 (Equal? (Sort < (List 3 1 0 2 4)) (List 0 1 2 3 4)) 115 125 (equal? 116 126 (receive (head tail) (Splitat 5 (Cardinals)) 117 127 (cons (First tail) (List>list head))) 118 128 '(5 0 1 2 3 4)) 119 (equal?120 (receive (head tail) (Splitat 15 (Take 5 (Cardinals)))121 (append (List>list tail) (List>list head)))122 '(0 1 2 3 4))123 129 "FOLDS" 130 (define (consright var lst) 131 (if (null? lst) 132 (cons var lst) 133 (cons (car lst) (consright var (cdr lst))))) 134 (equal? (consright 10 '(0 1 2 3)) '(0 1 2 3 10)) 124 135 (= (Foldleft + 0 (Take 5 (Cardinals))) 10) 125 136 (= (Foldleft + 0 (Firstfive) (Firstfive)) 20) … … 127 138 (equal? (Foldleft cons '() (Take 5 (Cardinals))) 128 139 '(((((() . 0) . 1) . 2) . 3) . 4)) 129 (equal? ( Ref4 (Foldleft* cons '() (Cardinals)))140 (equal? (At 4 (Foldleft* cons '() (Cardinals))) 130 141 '(((((() . 0) . 1) . 2) . 3) . 4)) 131 142 (= (Foldright + 0 (Take 5 (Cardinals))) 10) 132 143 (= (Foldright + 0 (Firstfive) (Firstfive)) 20) 133 144 (equal? (Foldright cons '() (Firstfive)) 134 '(0 1 2 3 4)) ; list145 '(0 1 2 3 4)) 135 146 (equal? (Foldright cons '(a b c) (Firstfive)) 136 147 '(0 1 2 3 4 a b c)) ; append 137 (equal? ( Ref4 (Foldright* cons '() (Cardinals)))148 (equal? (At 4 (Foldright* cons '() (Cardinals))) 138 149 '(4 3 2 1 0)) ; note changed order 139 (equal? ( Ref4 (Foldright* consright '() (Cardinals)))150 (equal? (At 4 (Foldright* consright '() (Cardinals))) 140 151 '(0 1 2 3 4)) 141 (equal? ( Ref4 (Foldright* cons '(a b c) (Cardinals)))152 (equal? (At 4 (Foldright* cons '(a b c) (Cardinals))) 142 153 '(4 3 2 1 0 a b c)) ; note changed order 143 (equal? ( Ref4 (Foldright* consright '(a b c) (Cardinals)))154 (equal? (At 4 (Foldright* consright '(a b c) (Cardinals))) 144 155 '(a b c 0 1 2 3 4)) 145 156 "TRANSFORMATIONS" 146 ( equal? (List>list (vector>List '#(0 1 2 3 4))) '(0 1 2 3 4))147 (Null? (vector>List '#()))148 (equal? (List>vector (Take 5 (Cardinals))) '#(0 1 2 3 4))149 (equal? (List>vector (Firstfive)) '#(0 1 2 3 4))157 (Equal? (vector>List #(0 1 2 3 4)) (List 0 1 2 3 4)) 158 (Null? (vector>List #())) 159 (equal? (List>vector (Take 5 (Cardinals))) #(0 1 2 3 4)) 160 (equal? (List>vector (Firstfive)) #(0 1 2 3 4)) 150 161 (equal? (List>vector Nil) '#()) 151 ( eq? (Every? odd? (Take 15 (Filter odd? (Cardinals)))) #t)152 ( eq? (Every? odd? (Take 15 (Cardinals))) #f)153 ( eq? (Every? odd? Nil) #t)154 ( eq? (Some? odd? Nil) #f)155 ( eq? (Some? odd? (Take 5 (Filter even? (Cardinals)))) #f)156 ( eq? (Some? odd? (Firstfive)) #t)162 (Every? odd? (Take 15 (Filter odd? (Cardinals)))) 163 (not (Every? odd? (Take 15 (Cardinals)))) 164 (Every? odd? Nil) 165 (not (Some? odd? Nil)) 166 (not (Some? odd? (Take 5 (Filter even? (Cardinals))))) 167 (Some? odd? (Firstfive)) 157 168 "ZIP AND UNZIP" 158 ( eq? (Length (Zip (Cardinals) (Firstfive))) #f)159 ( eq? (Length (Zip (Firstfive) (Cardinals))) #f)160 ( eq? (Length (Zip (Cardinals) (Cardinals))) #f)169 (not (Length (Zip (Cardinals) (Firstfive)))) 170 (not (Length (Zip (Firstfive) (Cardinals)))) 171 (not (Length (Zip (Cardinals) (Cardinals)))) 161 172 (= (Length (Zip (Firstfive) (Firstfive))) 10) 162 173 (Eqv? (Take 14 (Zip (Cardinals) (Firstfive))) … … 170 181 (Eqv? (Take 5 Odds) (List 1 3 5 7 9)))) 171 182 "PRIMES AND FIBS" 172 (= ( Ref50 (Primes)) 233)183 (= (At 50 (Primes)) 233) 173 184 (Eqv? (Take 5 (Primes)) (List 2 3 5 7 11)) 174 185 (Eqv? (Take 10 (Fibs)) (List 0 1 1 2 3 5 8 13 21 34)) 175 186 "LIST OF SUMS" 176 187 (define (Sums Lst) 177 (letrec ((sums (Cons 0 (Map + Lst (Lazy (Length Lst) sums))))) 178 (Rest sums))) 179 (equal? (List>list (Sums (Firstfive))) '(0 1 3 6 10)) 188 (let loop ((n 1)) 189 (Lazy #f (cons (apply + (List>list (Take n Lst))) 190 (loop (fx+ n 1)))))) 191 (Eqv? (Take 5 (Sums (Cardinals))) (List 0 1 3 6 10)) 180 192 "COMPUTE SQUARE ROOT BY NEWTON'S METHOD" 181 193 (define (Within eps Lst) 182 194 (let loop ((Lst Lst)) 183 (let ((a ( Ref 0 Lst)) (b (Ref1 Lst)))195 (let ((a (At 0 Lst)) (b (At 1 Lst))) 184 196 (if (< (abs ( a b)) eps) 185 197 b … … 187 199 (define (Relative eps Lst) 188 200 (let loop ((Lst Lst)) 189 (let ((a ( Ref 0 Lst)) (b (Ref1 Lst)))201 (let ((a (At 0 Lst)) (b (At 1 Lst))) 190 202 (if (<= (abs (/ a b)) (* (abs b) eps)) 191 203 b … … 201 213 (not (Listfinite? Integers)) 202 214 (not (Realized? Integers)) 203 (= ( Ref5 Integers) 6)215 (= (At 5 Integers) 6) 204 216 (Realized? Integers) 205 217 )) 
release/4/lazylists/trunk/lazylists.scm
r31803 r33876 2 2 ; ju (at) jugilo (dot) de 3 3 ; 4 ; Copyright (c) 2012201 4, Juergen Lorenz, Moritz Heidkamp4 ; Copyright (c) 20122017, Juergen Lorenz 5 5 ; All rights reserved. 6 6 ; … … 31 31 ; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 32 32 ; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 ; 34 ; Last update: Nor 09, 2014 35 ; 33 34 #[ 35 The lazylist implementation of this module is inspired by Moritz 36 Heidkamp's lazyseq egg. It's not based on the Scheme primitives delay 37 and force, but uses a record type instead. I've added an additional slot 38 to this recordtype, a boolean, finite?, so that it is possible to 39 discriminate between finite and infinite lazy lists without realizing 40 the whole record. After all, some routines, reverse for example, make 41 only sense for finite lists. Moreover, the names of all exported 42 routines are capitalized, so that I could reuse the familiar names of 43 eager lists without fear of name clashes. 44 I followed a consistent argument order, at least in principle: List 45 arguments are always last, procedure arguments always first. Some well 46 known list primitives, Listref and Listtail, with wrong argument 47 order, are still there, but accompanied by At and Drop with the right 48 order. 49 ]# 50 36 51 (module lazylists 37 (lazylists Lazy assumeinMakelazy52 (lazylists assumein Lazy Makelazy 38 53 List>list list>List input>List 39 54 First Rest Car Cdr Length Lengthmin Append Reverse … … 41 56 Listinfinite? Realize 42 57 Listnotnull? Listfinite? Listsonefinite? 43 Take Drop Ref Takewhile Dropwhile Countwhile 58 At Ref Listref Listtail 59 Take Drop Takewhile Dropwhile Countwhile 44 60 Memp Member Memq Memv 45 61 Equ? Equal? Eq? Eqv? … … 57 73 (only datastructures o compress listof?) 58 74 (only chicken 59 condexpand60 75 definerecordtype 61 76 definerecordprinter 62 cut when caselambda 63 nthvalue unless receive 64 makeparameter error void add1 sub1 65 fixnum? fx+ fx= fx>= fx< fx fx/)) 66 77 definereaderctor 78 cut caselambda 79 unless receive 80 makeparameter error void 81 fixnum? fx+ fx= fx>= fx< fx> fx fx/ fxshr)) 82 83 ;; documentation procedure 67 84 (define lazylists 68 85 (let ( 69 86 (signatures '( 70 (Lazy len xpr . xprs)71 87 (assumein sym test . tests) 72 (Makelazy len thunk) 88 (Lazy finite? xpr . xprs) 89 (Makelazy finite? thunk) 73 90 (List>list Lstfinite) 74 91 (list>List lst) … … 103 120 (Take k Lst) 104 121 (Drop k Lst) 122 (Listtail Lst k) 105 123 (Ref k Lst) 124 (Listref Lst k) 125 (At k Lst) 106 126 (Takewhile ok? Lst) 107 127 (Dropwhile ok? Lst) … … 126 146 (Map fn . Lsts) 127 147 (Foreach proc . Lsts) 128 (Iterate [n] fn x)129 (Repeat [n] x)130 (Repeatedly [n] thunk)131 (Cycle [ n] Lst)148 (Iterate fn x [times]) 149 (Repeat x [times]) 150 (Repeatedly thunk [times]) 151 (Cycle [times] Lst) 132 152 (Range [from] upto [step]) 133 153 (Cardinals) … … 136 156 (Merge <? Lstfinite1 Lstfinite2) 137 157 (Sorted? <? Lstfinite) 138 (Foldright op base . Lstsonefinite)139 (Foldleft op base . Listsonefinite)140 (Foldright* op base . Lsts)141 (Foldleft* op base . Lsts)158 (Foldright op base Lst . Lsts) 159 (Foldleft op base Lst . Lsts) 160 (Foldright* op base Lst . Lsts) 161 (Foldleft* op base Lst . Lsts) 142 162 (Zip Lst1 Lst2) 143 163 (Unzip Lst) … … 179 199 (define lazylist 180 200 (definerecordtype lazylist 181 (makelazylist lengthbody value)201 (makelazylist finite? body value) 182 202 lazylist? 183 ( length lazylistlength lazylistlengthset!)203 (finite? lazylistfinite?) 184 204 (body lazylistbody lazylistbodyset!) 185 205 (value lazylistvalue lazylistvalueset!))) … … 187 207 (definesyntax Lazy 188 208 (syntaxrules () 189 ((_ lenxpr . xprs)190 (Makelazy len(lambda () xpr . xprs)))))191 192 193 (define (Makelazy lenthunk)194 (makelazylist lenthunk #f))209 ((_ finite? xpr . xprs) 210 (Makelazy finite? (lambda () xpr . xprs))))) 211 212 213 (define (Makelazy finite? thunk) 214 (makelazylist finite? thunk #f)) 195 215 196 216 (define (Cons var Lst) 197 217 (assumein 'Cons 198 218 (List? Lst)) 199 (let (( len (lazylistlengthLst)))200 (Lazy (if len (+ 1 len) #f)219 (let ((finite? (lazylistfinite? Lst))) 220 (Lazy finite? 201 221 (cons var Lst)))) 202 222 203 (define Length lazylistlength) 223 (define (Length Lst) 224 (assumein 'Length 225 (List? Lst)) 226 (if (lazylistfinite? Lst) 227 (let loop ((Lst Lst) (result 0)) 228 (if (Null? Lst) 229 result 230 (loop (Rest Lst) (fx+ 1 result)))) 231 #f)) 204 232 205 233 (define (Lengthmin . Lsts) 206 234 (assumein 'Lengthmin 207 235 ((listof? List?) Lsts)) 208 (let * ((lens (map Length Lsts))209 (finites (compress lens lens)))210 (if (null? finites)236 (let ((Finites (compress (map lazylistfinite? Lsts) 237 Lsts))) 238 (if (null? Finites) 211 239 #f 212 (apply min finites))))240 (apply min (map Length Finites))))) 213 241 214 242 (define List? lazylist?) 215 243 216 244 (define Nil 217 (makelazylist 0(lambda () '()) #f))245 (makelazylist #t (lambda () '()) #f)) 218 246 219 247 (definerecordprinter (lazylist Lst out) 220 248 (assumein 'definerecordprinter 221 249 (List? Lst)) 222 (display "#(List[" out) 223 (display (lazylistlength Lst) out) 250 (display "#,(List[" out) 251 (display (if (lazylistfinite? Lst) 252 "finite" 253 "infinite") out) 254 ;(display (lazylistfinite? Lst) out) 224 255 (display "]" out) 225 256 (cond ((not (Realized? Lst)) … … 254 285 (assumein 'Realize 255 286 (Listfinite? Lst)) 256 (let ((len (lazylistlength Lst))) 257 (when len 258 (Ref ( len 1) Lst) 259 Lst))) 287 ;(let ((len (Length Lst))) 288 ; (when len 289 ; (At (fx len 1) Lst) 290 ; Lst))) 291 (At (fx (Length Lst) 1) Lst) 292 Lst) 260 293 261 294 (define (Realized? Lst) … … 273 306 (car (realize Lst))) 274 307 275 (define (Car Lst) 276 (assumein 'Car 277 (List? Lst)) 278 (First Lst)) 279 280 ;; to speed up cdring for lists with preknown length 281 (define (rest Lst) 282 (assumein 'rest (List? Lst)) 283 (cdr (realize Lst))) 308 (define Car First) 284 309 285 310 (define (Rest Lst) 286 311 (assumein 'Rest (List? Lst)) 287 (let ( 288 (len (lazylistlength Lst)) 289 (Result (cdr (realize Lst))) 290 ) 291 (lazylistlengthset! Result (if len (fx len 1) #f)) 292 Result)) 293 294 (define (Cdr Lst) 295 (assumein 'Cdr (List? Lst)) 296 (Rest Lst)) 297 312 (cdr (realize Lst))) 313 314 (define Cdr Rest) 315 316 ;; deprecated 317 ;; makes finite Lists eager!!! 318 ;; and if checked traverses Lists twice 298 319 (define (Admissible? n Lst) 299 320 (assumein 'Admissible? … … 301 322 (fixnum? n) 302 323 (fx>= n 0)) 303 (let ((len ( lazylistlength Lst)))324 (let ((len (Length Lst)));(lazylistlength Lst))) 304 325 (or (not len) (fx< n len)))) 305 326 306 (define (Ref n Lst) 307 (assumein 'Ref 308 (Admissible? n Lst)) 309 (let ((len (lazylistlength Lst))) 310 (let loop ((n n) (Lst Lst)) 311 (if (fx= n 0) 312 (First Lst) 313 (loop (fx n 1) (Rest Lst)))))) 327 (define (At k Lst) 328 (assumein 'At 329 (List? Lst) (fx>= k 0)) 330 (cond 331 ((Null? Lst) 332 (error 'At "out of range" k Lst)) 333 ((fx= 0 k) 334 (First Lst)) 335 (else 336 (At (fx k 1) (Rest Lst))))) 337 338 ;; deprecated 339 (define Ref At) 340 341 (define (Listref Lst k) 342 (At k Lst)) 314 343 315 344 (define (List>list Lst) … … 328 357 (if (null? lst) 329 358 Lst 330 (loop (cdr lst) (Cons (car lst) Lst))))) 359 (loop (cdr lst) 360 (Lazy #t (cons (car lst) Lst)))))) 331 361 332 362 (define (List . args) 333 363 (list>List args)) 334 364 365 (definereaderctor 'List List) 366 367 ;; Drop and Take as well as Splitat now check n parameter 335 368 (define (Take n Lst) 336 369 (assumein 'Take … … 338 371 (fixnum? n) 339 372 (fx>= n 0)) 340 (callwithvalues 341 (lambda () (Splitat n Lst)) 342 (lambda (a b) a))) 343 373 (if (and (Null? Lst) (fx> n 0)) 374 (error 'Take "out of bounds" Lst n) 375 (Lazy #t 376 (if (or (fx= n 0) (Null? Lst)) 377 '() 378 (cons 379 (First Lst) 380 (Take (fx n 1) (Rest Lst))))))) 381 344 382 (define (Drop n Lst) 345 383 (assumein 'Drop 346 (Admissible? n Lst)) 347 (callwithvalues 348 (lambda () (Splitat n Lst)) 349 (lambda (a b) b))) 384 (List? Lst) 385 (fixnum? n) 386 (fx>= n 0)) 387 (cond 388 ((and (Null? Lst) (fx> n 0)) 389 (error 'Drop "out of bounds" Lst n)) 390 ((or (zero? n) (Null? Lst)) 391 Lst) 392 (else 393 (Drop (fx n 1) (Rest Lst))))) 394 395 (define (Listtail Lst n) 396 (Drop n Lst)) 397 398 (define (Splitat n Lst) 399 (values (Take n Lst) (Drop n Lst))) 350 400 351 401 (define (Takewhile ok? Lst) … … 353 403 (Listfinite? Lst) 354 404 (procedure? ok?)) 355 (nthvalue 0 (Splitwith ok? Lst))) 405 (let ((finite? (lazylistfinite? Lst))) 406 (let loop ((Lst Lst)) 407 (Lazy finite? 408 (cond 409 ((Null? Lst) 410 '()) 411 ((ok? (First Lst)) 412 (cons (First Lst) (loop (Rest Lst)))) 413 (else '())))))) 414 ; (Lazy (lazylistfinite? Lst) 415 ; (let loop ((Lst Lst)) 416 ; (cond 417 ; ((Null? Lst) 418 ; '()) 419 ; ((ok? (First Lst)) 420 ; (cons (First Lst) (loop (Rest Lst)))) 421 ; (else '()))))) 356 422 357 423 (define (Countwhile ok? Lst) … … 359 425 (Listfinite? Lst) 360 426 (procedure? ok?)) 361 (nthvalue 1 (Splitwith ok? Lst))) 427 (let loop ((Lst Lst) (index 0)) 428 (cond 429 ((Null? Lst) 430 index) 431 ((ok? (First Lst)) 432 (loop (Rest Lst) (fx+ index 1))) 433 (else index)))) 362 434 363 435 (define (Dropwhile ok? Lst) … … 365 437 (Listfinite? Lst) 366 438 (procedure? ok?)) 367 (nthvalue 2 (Splitwith ok? Lst))) 439 (let ((finite? (lazylistfinite? Lst))) 440 (let loop ((Lst Lst)) 441 (Lazy finite? 442 (cond 443 ((Null? Lst) 444 '()) 445 ((ok? (First Lst)) 446 (loop (Rest Lst))) 447 (else Lst)))))) 448 449 (define (Splitwith ok? Lst) 450 (values (Takewhile ok? Lst) 451 (Countwhile ok? Lst) 452 (Dropwhile ok? Lst))) 368 453 369 454 (define (Memp ok? Lst) … … 374 459 375 460 (define (Memq var Lst) 376 (assumein 'Memq377 (Listfinite? Lst))461 ;(assumein 'Memq 462 ; (Listfinite? Lst)) 378 463 (Memp (cut eq? <> var) Lst)) 379 464 380 465 (define (Memv var Lst) 381 (assumein 'Memv382 (Listfinite? Lst))466 ;(assumein 'Memv 467 ; (Listfinite? Lst)) 383 468 (Memp (cut eqv? <> var) Lst)) 384 469 385 470 (define (Member var Lst) 386 (assumein 'Member387 (Listfinite? Lst))471 ;(assumein 'Member 472 ; (Listfinite? Lst)) 388 473 (Memp (cut equal? <> var) Lst)) 389 474 … … 393 478 (List? Lst1) 394 479 (List? Lst2)) 395 (if (eqv? (lazylistlength Lst1) (lazylistlength Lst2)) 396 (if (lazylistlength Lst1) 397 ;; both finite 398 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 399 (cond 400 ((Null? Lst1) #t) 401 ((=? (First Lst1) (First Lst2)) 402 (loop (Rest Lst1) (Rest Lst2))))) 403 ;; both infinite 404 (eq? Lst1 Lst2)) 405 #f)) 480 (cond 481 ((and (Listfinite? Lst1) (Listfinite? Lst2)) 482 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 483 (cond 484 ((and (Null? Lst1) (Null? Lst2)) 485 #t) 486 ((=? (First Lst1) (First Lst2)) 487 (loop (Rest Lst1) (Rest Lst2))) 488 (else #f)))) 489 ((and (Listinfinite? Lst1) (Listinfinite? Lst2)) 490 (eq? Lst1 Lst2)) 491 (else #f))) 406 492 407 493 (define (Eq? Lst1 Lst2) 408 (assumein 'Eq?409 (List? Lst1)410 (List? Lst2))494 ;(assumein 'Eq? 495 ; (List? Lst1) 496 ; (List? Lst2)) 411 497 (Equ? eq? Lst1 Lst2)) 412 498 413 499 (define (Eqv? Lst1 Lst2) 414 (assumein 'Eqv?415 (List? Lst1)416 (List? Lst2))500 ;(assumein 'Eqv? 501 ; (List? Lst1) 502 ; (List? Lst2)) 417 503 (Equ? eqv? Lst1 Lst2)) 418 504 419 505 (define (Equal? Lst1 Lst2) 420 (assumein 'Equal?421 (List? Lst1)422 (List? Lst2))506 ;(assumein 'Equal? 507 ; (List? Lst1) 508 ; (List? Lst2)) 423 509 (Equ? equal? Lst1 Lst2)) 424 510 … … 433 519 434 520 (define (Assq key al) 435 (assumein 'Assq 436 (symbol? key) 437 ((listof? pair?) al)) 521 ;(assumein 'Assq 522 ; ((listof? pair?) al)) 438 523 (Assp (cut eq? <> key) al)) 439 524 440 525 (define (Assv key al) 441 (assumein 'Assv442 ((listof? pair?) al))526 ;(assumein 'Assv 527 ; ((listof? pair?) al)) 443 528 (Assp (cut eqv? <> key) al)) 444 529 445 530 (define (Assoc key al) 446 (assumein 'Assoc447 ((listof? pair?) al))531 ;(assumein 'Assoc 532 ; ((listof? pair?) al)) 448 533 (Assp (cut equal? <> key) al)) 449 534 … … 463 548 (if (null? Lsts) 464 549 Nil 465 (let loop ((Lsts Lsts)) 466 (Lazy (apply Lengthmin Lsts) 467 (if (memp Null? Lsts) 468 '() 469 (cons (apply proc (map Car Lsts)) 470 (loop (map Cdr Lsts)))))))) 550 (let ((finite? (if (not (apply Lengthmin Lsts)) #f #t))) 551 (let loop ((Lsts Lsts)) 552 (Lazy finite? 553 (if (memp Null? Lsts) 554 '() 555 (cons (apply proc (map Car Lsts)) 556 (loop (map Cdr Lsts))))))))) 471 557 472 558 (define (Foreach proc . Lsts) … … 485 571 (List? Lst)) 486 572 (let ((ev? #f)) 487 (let loop ((Lst Lst)) 488 (cond 489 ((Null? Lst) 490 (values Nil Nil)) 491 (else 492 (set! ev? (not ev?)) 493 (if (lazylistlength Lst) 494 ;; compute new length via Cons 573 (let ((finite? (lazylistfinite? Lst))) 574 (let loop ((Lst Lst)) 575 (cond 576 ((Null? Lst) 577 (values Nil Nil)) 578 (else 579 (set! ev? (not ev?)) 495 580 (if ev? 496 (values (Cons (First Lst) (loop (Rest Lst))) 497 (loop (Rest Lst))) 498 (values (loop (Rest Lst)) 499 (Cons (First Lst) (loop (Rest Lst))))) 500 ;; set new length #f 501 (if ev? 502 (values (Lazy #f (cons (First Lst) (loop (rest Lst)))) 503 (Lazy #f (loop (rest Lst)))) 504 (values (Lazy #f (loop (rest Lst))) 505 (Lazy #f (cons (First Lst) (loop (rest Lst)))))))))))) 581 (values (Lazy finite? 582 (cons (First Lst) (loop (Rest Lst)))) 583 (Lazy finite? 584 (loop (Rest Lst)))) 585 (values (Lazy finite? 586 (loop (Rest Lst))) 587 (Lazy finite? 588 (cons (First Lst) (loop (Rest Lst)))))))))))) 506 589 507 590 (define (Zip Lst1 Lst2) … … 509 592 (List? Lst1) 510 593 (List? Lst2)) 511 ( if (Null? Lst1)512 Lst2513 (if (and (lazylistlength Lst1) (lazylistlength Lst2))514 ;; both finite, compute new length with Cons515 ( Cons (First Lst1) (Zip Lst2 (Rest Lst1)))516 ;; new length infinite517 (Lazy #f518 (cons (First Lst1) (Zip Lst2 (Rest Lst1)))))))594 (let ((bothfinite? 595 (and (lazylistfinite? Lst1) 596 (lazylistfinite? Lst2)))) 597 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 598 (if (Null? Lst1) 599 Lst2 600 (Lazy bothfinite? 601 (cons (First Lst1) (loop Lst2 (Rest Lst1)))))))) 519 602 520 603 (define (Filter ok? Lst) 521 604 (assumein 'Filter 522 (List? Lst)) 523 (let loop ((Lst Lst)) 524 (if (Null? Lst) 525 Nil 526 (let ((first (First Lst)) 527 (Result (if (lazylistlength Lst) 528 (loop (Rest Lst)) 529 (Lazy #f (loop (rest Lst)))))) 530 (if (ok? first) 531 (Cons first Result) 532 Result))))) 533 ; (if (Null? Lst) 534 ; (values Nil Nil) 535 ; (let ((first (First Lst))) 536 ; (if (lazylistlength Lst) 537 ; (receive (Yes No) (Filter ok? (Rest Lst)) 538 ; (if (ok? first) 539 ; (values (Cons first Yes) No) 540 ; (values Yes (Cons first No)))) 541 ; (let ((yes (Lazy #f (Filter ok? (rest Lst)))) 542 ; (no (Lazy #f (Filter (o not ok?) (rest Lst))))) 543 ; ;(receive (yes no) (Filter ok? (rest Lst)) ; wrong 544 ; (if (ok? first) 545 ; (values (Cons first yes) no) 546 ; (values yes (Cons first no)))))))) 605 (List? Lst) 606 (procedure? ok?)) 607 (let ((finite? (lazylistfinite? Lst))) 608 (let loop ((Lst Lst)) 609 (Lazy finite? 610 (if (Null? Lst) 611 '() 612 (let ((first (First Lst)) (rest (Rest Lst))) 613 (if (ok? first) 614 (cons first (loop rest)) 615 (loop rest)))))))) 547 616 548 617 (define (Remp ok? Lst) … … 560 629 (define (input>List port read) 561 630 (let loop () 562 ;(Lazy #f631 (Lazy #f 563 632 (let ((datum (read port))) 564 633 (if (eofobject? datum) 565 Nil566 ( Cons datum (loop))))));)634 '() 635 (cons datum (loop))))))) 567 636 568 637 (define Repeat 569 638 (caselambda 570 639 ((x) (Lazy #f (cons x (Repeat x)))) 571 (( n x)640 ((x times) 572 641 (assumein 'Repeat 573 (fixnum? n)574 (fx>= n0))575 (Take n(Repeat x)))))642 (fixnum? times) 643 (fx>= times 0)) 644 (Take times (Repeat x))))) 576 645 577 646 (define Repeatedly … … 581 650 (procedure? thunk)) 582 651 (Lazy #f (cons (thunk) (Repeatedly thunk)))) 583 (( n thunk)652 ((thunk times) 584 653 (assumein 'Repeatedly 585 (procedure? thunk) 586 (fixnum? n) 587 (fx>= n 0)) 588 (Take n (Repeatedly thunk))))) 654 (fixnum? times) 655 (fx>= times 0)) 656 (Take times (Repeatedly thunk))))) 589 657 590 658 (define Iterate 591 659 (caselambda 592 ((f x)660 ((fn x) 593 661 (assumein 'Iterate 594 (procedure? f ))595 (Lazy #f (cons x (Iterate f (fx)))))596 (( n f x)662 (procedure? fn)) 663 (Lazy #f (cons x (Iterate fn (fn x))))) 664 ((fn x times) 597 665 (assumein 'Iterate 598 (procedure? f) 599 (fixnum? n) 600 (fx>= n 0)) 601 (Take n (Iterate f x))))) 666 (fixnum? times) 667 (fx>= times 0)) 668 (Take times (Iterate fn x))))) 602 669 603 670 (define Cycle … … 613 680 (loop Lst) 614 681 (cons (First tail) 615 (loop ( rest tail))))))))682 (loop (Rest tail)))))))) 616 683 ((n Lst) 617 684 (assumein 'Cycle 618 (List? Lst)619 685 (fixnum? n) 620 686 (fx>= n 0)) … … 624 690 (caselambda 625 691 ((upto) 626 (Iterate (abs upto) 627 (if (fx>= upto 0) 692 (Iterate (if (fx>= upto 0) 628 693 (cut fx+ <> 1) 629 694 (cut fx <> 1)) 630 0)) 695 0 696 (abs upto))) 631 697 ((from upto) 632 (Iterate (abs (fx upto from)) 633 (if (fx>= upto from) 698 (Iterate (if (fx>= upto from) 634 699 (cut fx+ <> 1) 635 700 (cut fx <> 1)) 636 from)) 701 from 702 (abs (fx upto from)) 703 )) 637 704 ((from upto step) 638 (Iterate (fx/ (fx+ (fx step 1) (abs (fx upto from))) step) 639 (if (fx>= upto from) 705 (Iterate (if (fx>= upto from) 640 706 (cut fx+ <> step) 641 707 (cut fx <> step)) 642 from)))) 643 644 (define (Append2 Lst1 Lst2) 645 (if (not (lazylistlength Lst1)) 646 Lst1 647 (let loop ((Lst Lst1)) 648 (Lazy (if (lazylistlength Lst2) 649 (+ (lazylistlength Lst1) 650 (lazylistlength Lst2)) 651 #f) 652 (if (Null? Lst) 653 Lst2 654 (cons (First Lst) (loop (rest Lst)))))))) 655 656 (define (Append . Lsts) 657 (assumein 'Append 658 ((listof? Listfinite?) (butlast Lsts)) 659 (List? (last Lsts))) 660 (cond 661 ((null? Lsts) Nil) 662 ((null? (cdr Lsts)) (car Lsts)) 663 (else 664 (Append2 (car Lsts) (apply Append (cdr Lsts)))))) 665 666 (define (Reverse Lst) 667 (assumein 'Reverse 668 (Listfinite? Lst)) 669 (let loop ((Lst Lst) (reverse Nil)) 670 (if (Null? Lst) 671 reverse 672 (Lazy (lazylistlength Lst) 673 (loop (rest Lst) 674 (Cons (First Lst) reverse)))))) 708 from 709 (fx/ (fx+ (fx step 1) (abs (fx upto from))) step) 710 )))) 711 712 (define Append 713 (caselambda 714 ((Lst1 Lst2) 715 (assumein 'Append 716 (List? Lst1) (List? Lst2)) 717 (if (Listinfinite? Lst1) 718 Lst1 719 (let ((finite? (lazylistfinite? Lst2))) 720 (let loop ((Lst1 Lst1)) 721 (Lazy finite? 722 (if (Null? Lst1) 723 Lst2 724 (cons (First Lst1) (loop (Rest Lst1))))))))) 725 ((Lst . Lsts) 726 (if(Null? Lsts) 727 Lst 728 (apply Append 729 (Append Lst (First Lsts)) 730 (Rest Lsts)))) 731 )) 732 733 (define Reverse 734 (caselambda 735 ((Lst1 Lst2) 736 (assumein 'Reverse 737 (Listfinite? Lst1) (List? Lst2)) 738 (let ((finite? (lazylistfinite? Lst2))) 739 (let loop ((Lst1 Lst1) (Result Lst2)) 740 (if (Null? Lst1) 741 Result 742 (loop (Rest Lst1) 743 (Lazy finite? 744 (cons (First Lst1) Result))))))) 745 ((Lst) 746 (Reverse Lst Nil)))) 675 747 676 748 (define (Reverse* Lst) 677 749 (assumein 'Reverse* 678 750 (List? Lst)) 679 (letrec ( 680 (result 681 (Cons Nil 682 (Map Cons 683 Lst 684 (Lazy (lazylistlength Lst) result)))) 685 ) 686 (Rest result))) 751 (let ((finite? (lazylistfinite? Lst))) 752 (if (not finite?) 753 (let loop ((n 1)) 754 (Lazy #f (cons (Reverse (Take n Lst)) 755 (loop (fx+ n 1))))) 756 (let ((len (Length Lst))) 757 (let loop ((n 1)) 758 (Lazy #t 759 (if (fx= 0 len) 760 (list (First Lst)) 761 (cons (Reverse (Take n Lst)) 762 (loop (fx+ n 1)))))))))) 687 763 688 764 (define (Merge <? Lst1 Lst2) … … 691 767 (Listfinite? Lst1) 692 768 (Listfinite? Lst2)) 693 (let ((len (+ (lazylistlength Lst1) (lazylistlength Lst2))))694 ( let loop ((Lst1 Lst1) (Lst2 Lst2))695 ( cond696 ((Null? Lst1) Lst2)697 ((Null? Lst2) Lst1)698 ((<? (First Lst1) (First Lst2))699 ( Lazy len (cons (First Lst1) (loop (rest Lst1) Lst2))))700 701 (Lazy len702 (cons (First Lst2) (loop Lst1 (rest Lst2)))))))))769 (let loop ((Lst1 Lst1) (Lst2 Lst2)) 770 (cond 771 ((Null? Lst1) Lst2) 772 ((Null? Lst2) Lst1) 773 ((<? (First Lst1) (First Lst2)) 774 (Lazy #t 775 (cons (First Lst1) (loop (Rest Lst1) Lst2)))) 776 (else 777 (Lazy #t 778 (cons (First Lst2) (loop Lst1 (Rest Lst2)))))))) 703 779 704 780 (define (Sort <? Lst) … … 706 782 (procedure? <?) 707 783 (Listfinite? Lst)) 708 (let ((len ( lazylistlength Lst)))709 (if ( < len 2)784 (let ((len (Length Lst))) 785 (if (fx< len 2) 710 786 Lst 711 (let ((halflen ( quotient len 2)))787 (let ((halflen (fxshr len 1))) 712 788 (Merge <? 713 789 (Sort <? (Take halflen Lst)) … … 721 797 (cond 722 798 ((Null? Lst) #t) 723 ((Null? ( CdrLst)) #t)724 ((<? ( Car Lst) (Car (CdrLst)))725 (loop ( CdrLst)))799 ((Null? (Rest Lst)) #t) 800 ((<? (First Lst) (First (Rest Lst))) 801 (loop (Rest Lst))) 726 802 (else #f)))) 727 803 … … 729 805 (assumein 'vector>List 730 806 (vector? vec)) 731 (let loop ((res Nil) (n (vectorlength vec))) 732 (if (zero? n) 733 res 734 (loop (Cons (vectorref vec ( n 1)) res) ( n 1))))) 735 736 ;; see comment to List>list 807 (let loop ((Result Nil) (n (fx (vectorlength vec) 1))) 808 (if (fx< n 0) 809 Result 810 (loop (Lazy #t (cons (vectorref vec n) Result)) 811 (fx n 1))))) 737 812 (define (List>vector Lst) 738 813 (assumein 'List>vector 739 814 (Listfinite? Lst)) 740 (let ((vec (makevector (lazylistlength Lst) #f))) 741 (let loop ((k 0) (Lst Lst)) 742 (cond 743 ((Null? Lst) 744 vec) 745 (else 746 (vectorset! vec k (First Lst)) 747 (loop (+ k 1) (rest Lst))))))) 748 749 (define (Splitat n Lst) 750 (assumein 'Splitat 751 (Admissible? n Lst)) 752 (let loop ((n n) (head Nil) (tail Lst)) 753 (if (or (Null? tail) (zero? n)) 754 (values (Reverse head) tail) 755 (loop ( n 1) 756 (Cons (First tail) head) 757 (Rest tail))))) 758 759 (define (Splitwith ok? Lst) 760 (assumein 'Splitwith 761 (procedure? ok?) 762 (Listfinite? Lst)) 763 (let loop ((head Nil) (index 0) (tail Lst)) 764 (if (or (Null? tail) (not (ok? (First tail)))) 765 ;(if (or (Null? tail) (ok? (First tail))) 766 (values (Reverse head) index tail) 767 (loop (Cons (First tail) head) 768 (+ index 1) 769 (Rest tail))))) 815 (let* ((len (Length Lst)) (vec (makevector len #f))) 816 (do ((k 0 (fx+ k 1)) (Lst Lst (Rest Lst))) 817 ((fx= k len) vec) 818 (vectorset! vec k (First Lst))))) 770 819 771 820 (define (Sieve =? Lst) … … 773 822 (procedure? =?) 774 823 (List? Lst)) 775 (let loop ((Lst Lst)) 776 (if (Null? Lst) 777 Nil 778 (let ( 779 (first (First Lst)) 780 (tail 781 (Filter 782 (lambda (x) 783 (not (=? x (First Lst)))) 784 (Rest Lst))) 785 ) 786 (if (lazylistlength Lst) 787 (Cons first (loop tail)) 788 (Lazy #f 789 (cons first (loop tail)))))))) 790 791 (define (Foldleft op base . Lsts) 824 (let ((finite? (lazylistfinite? Lst))) 825 (let loop ((Lst Lst)) 826 (Lazy finite? 827 (if (Null? Lst) 828 '() 829 (let ( 830 (first (First Lst)) 831 (rest 832 (Filter 833 (lambda (x) 834 (not (=? x (First Lst)))) 835 (Rest Lst))) 836 ) 837 (cons first (loop rest)))))))) 838 839 (define (Foldleft op base Lst . Lsts) 792 840 (assumein 'Foldleft 793 841 (procedure? op) 794 ( apply Listsonefinite? Lsts))795 (let loop ((base base)796 (Lsts Lsts)797 (len (apply Lengthmin Lsts)))798 (if (zero?len)799 base800 (loop (apply op base (map First Lsts))801 (map Rest Lsts)802 (fx len 1)))))803 804 (define (Foldright op base . Lsts)842 (List? Lst) 843 (or (Listfinite? Lst) (apply Listsonefinite? Lsts))) 844 (let* ((Lsts (cons Lst Lsts)) (len (apply Lengthmin Lsts))) 845 (let loop ((Lsts Lsts) (k 0) (result base)) 846 (if (fx= k len) 847 result 848 (loop (map Cdr Lsts) 849 (fx+ k 1) 850 (apply op result (map Car Lsts))))))) 851 852 (define (Foldright op base Lst . Lsts) 805 853 (assumein 'Foldright 806 854 (procedure? op) 807 (apply Listsonefinite? Lsts)) 808 (let loop ((Lsts Lsts) 809 (len (apply Lengthmin Lsts))) 810 (if (zero? len) 811 base 812 (apply op 813 (append (map First Lsts) 814 (list (loop (map Rest Lsts) (fx len 1)))))))) 855 (List? Lst) 856 (or (Listfinite? Lst) (apply Listsonefinite? Lsts))) 857 (let* ((Lsts (cons Lst Lsts)) (len (apply Lengthmin Lsts))) 858 (let loop ((Lsts Lsts) (len len)) 859 (if (fx= 0 len) 860 base 861 (apply op 862 (append (map First Lsts) 863 (list (loop (map Rest Lsts) (fx len 1))))))))) 815 864 816 865 ;;; The following two routines return Lists 817 (define (Foldleft* op base . Lsts)866 (define (Foldleft* op base Lst . Lsts) 818 867 (assumein 'Foldleft* 819 868 (procedure? op) 869 (List? Lst) 820 870 ((listof? List?) Lsts)) 821 (letrec ( 822 (fold 823 (Cons base 824 (apply Map op 825 (Lazy (apply Lengthmin Lsts) fold) 826 Lsts))) 827 ) 828 (Rest fold))) 829 830 (define (Foldright* op base . Lsts) ; changes order of List items 871 (let* ((Lsts (cons Lst Lsts)) 872 (finite? (if (not (apply Lengthmin Lsts)) 873 #f 874 #t))) 875 (letrec ( 876 (fold 877 (Lazy finite? 878 (cons base 879 (apply Map op 880 (Lazy finite? fold) 881 Lsts)))) 882 ) 883 (Rest fold)))) 884 885 (define (Foldright* op base Lst . Lsts) ; changes order of List items 831 886 (assumein 'Foldright* 832 887 (procedure? op) 888 (List? Lst) 833 889 ((listof? List?) Lsts)) 834 (letrec ( 835 (fold 836 (Cons base 837 (apply Map op 838 (append Lsts 839 (list 840 (Lazy (apply Lengthmin Lsts) fold)))))) 841 ) 842 (Rest fold))) 890 (let* ((Lsts (cons Lst Lsts)) 891 (finite? (if (not (apply Lengthmin Lsts)) 892 #f 893 #t))) 894 (letrec ( 895 (fold 896 (Lazy finite? 897 (cons base 898 (apply Map op 899 (append Lsts 900 (list 901 (Lazy finite? fold))))))) 902 ) 903 (Rest fold)))) 843 904 844 905 (define (Every? ok? Lst) … … 869 930 870 931 (define (Listfinite? xpr) 871 (and (List? xpr) (if (Length xpr) #t #f))) 932 (and (List? xpr) ; (if (Length xpr) #t #f))) 933 (lazylistfinite? xpr))) 872 934 873 935 (define (Listinfinite? xpr) 874 (and (List? xpr) (if (Length xpr) #f #t))) 936 (and (List? xpr) ;(if (Length xpr) #f #t))) 937 (not (lazylistfinite? xpr)))) 875 938 876 939 (define (Listsonefinite? . Lsts) … … 878 941 (not (null? Lsts)) 879 942 ((listof? List?) Lsts)) 880 (if (apply Lengthmin Lsts) #t #f)) 943 ;(if (apply Lengthmin Lsts) #t #f)) 944 (not (null? (compress (map lazylistfinite? Lsts) 945 Lsts)))) 881 946 882 947 ;;; two examples 
release/4/lazylists/trunk/lazylists.setup
r31803 r33876 8 8 'lazylists 9 9 '("lazylists.so" "lazylists.import.so") 10 '((version "0. 8.1")))10 '((version "0.9"))) 
release/4/lazylists/trunk/tests/run.scm
r31797 r33876 1 (requirelibrary lazylists simpletests)1 (requirelibrary simpletests lazylists) 2 2 (import lazylists simpletests) 3 3 (registerfeature! 'assumptionschecked) … … 5 5 (definetest (lazylist) 6 6 (check 7 (define (consright var lst)8 (if (null? lst)9 (cons var lst)10 (cons (car lst) (consright var (cdr lst)))))11 7 (define (Firstfive) (List 0 1 2 3 4)) 12 8 (define (Fibs) … … 26 22 (= (Length (Firstfive)) 5) 27 23 (= (Length (Rest (Firstfive))) 4) 28 ( eq? (Length (Rest (Cardinals))) #f)24 (not (Length (Rest (Cardinals)))) 29 25 (= (Length (Take 5 (Cardinals))) 5) 30 ( eq? (Length (Cardinals)) #f)31 ( eq? (Length (Drop 5 (Cardinals))) #f)26 (not (Length (Cardinals))) 27 (not (Length (Drop 5 (Cardinals)))) 32 28 (= (First (Drop 5 (Cardinals))) 5) 33 ( equal? (List>list (Firstfive)) '(0 1 2 3 4))34 ( equal? (List>list (Take 5 (Cardinals))) '(0 1 2 3 4))29 (Eqv? (Firstfive) (List 0 1 2 3 4)) 30 (Eqv? (Take 5 (Cardinals)) (List 0 1 2 3 4)) 35 31 (= (Length (Range 2 10)) ( 10 2)) 36 32 (= (Length (Range 10)) 10) 37 33 (= (Length (Range 1 10 2)) 6) 38 (equal? (List>list (Range 1 10 2)) '(1 1 3 5 7 9)) 39 (equal? (List>list (Range 2 10)) '(2 3 4 5 6 7 8 9)) 40 (equal? (List>list (Range 10 2)) '(10 9 8 7 6 5 4 3)) 34 (Eqv? (Range 1 10 2) (List 1 1 3 5 7 9)) 35 (Eqv? (Range 2 10) (List 2 3 4 5 6 7 8 9)) 36 (Eqv? (Range 10 2) (List 10 9 8 7 6 5 4 3)) 37 (Eqv? (Dropwhile (cut < <> 3) (Firstfive)) 38 (List 3 4)) 39 (Eqv? (Takewhile (cut < <> 3) (Firstfive)) 40 (List 0 1 2)) 41 41 (equal? 42 42 (receive (head index tail) (Splitwith (cut < <> 3) (Firstfive)) … … 49 49 (= (Countwhile (cut < <> 2) (Firstfive)) 2) 50 50 (= (Countwhile (cut < <> 20) (Firstfive)) 5) 51 ( equal? (List>list (Takewhile (cut < <> 5) (Take 10 (Cardinals))))52 '(0 1 2 3 4))51 (Eqv? (Takewhile (cut < <> 5) (Take 10 (Cardinals))) 52 (List 0 1 2 3 4)) 53 53 (= (Length (Takewhile (cut < <> 5) (Take 10 (Cardinals)))) 5) 54 54 (= (Length (Dropwhile (cut < <> 5) (Take 10 (Cardinals)))) 5) … … 56 56 (= (Length (Dropwhile (cut < <> 2) (Firstfive))) 3) 57 57 (= (First (Dropwhile (cut < <> 2) (Firstfive))) 2) 58 ( equal? (List>list (Memp odd? (Firstfive))) '(1 2 3 4))59 ( equal? (List>list (Memv 5 (Take 10 (Cardinals)))) '(5 6 7 8 9))58 (Eqv? (Memp odd? (Firstfive)) (List 1 2 3 4)) 59 (Eqv? (Memv 5 (Take 10 (Cardinals))) (List 5 6 7 8 9)) 60 60 (equal? (Assv 5 (Take 10 (Map (lambda (x) (list x x)) (Cardinals)))) 61 61 '(5 5)) 62 (eq? (Assv 10 (Map (lambda (x) (list x x)) (Firstfive))) #f) 63 (eq? (Equal? (Cardinals) (Cardinals)) #f) 64 (eq? (Equal? (Cardinals) (Firstfive)) #f) 65 (eq? (Equal? (Firstfive) (Firstfive)) #t) 62 (not (Assv 10 (Map (lambda (x) (list x x)) (Firstfive)))) 63 (not (Equal? (Cardinals) (Cardinals))) 64 (let ((Card (Cardinals))) 65 (Equal? Card Card)) 66 (not (Equal? (Cardinals) (Firstfive))) 67 (Equal? (Firstfive) (Firstfive)) 66 68 (= (Length (Take 10 (Cardinals))) 10) 67 ( equal? (List>list (Take 5 (Filter odd? (Drop 1 (Cardinals)))))68 '(1 3 5 7 9))69 (Eqv? (Take 5 (Filter odd? (Drop 1 (Cardinals)))) 70 (List 1 3 5 7 9)) 69 71 (Eqv? (Remp odd? (Firstfive)) (List 0 2 4)) 70 72 (Eqv? (Take 5 (Remp odd? (Cardinals))) 71 73 (Take 5 (Map (cut * <> 2) (Cardinals)))) 72 74 (Eqv? (Remv 3 (Firstfive)) (List 0 1 2 4)) 73 ( eq? (Length (Cardinals)) #f)74 ( equal? (List>list (Map add1 (Firstfive))) '(1 2 3 4 5))75 ( equal? (List>list (Map + (Firstfive) (Take 5 (Cardinals))))76 '(0 2 4 6 8))77 ( eq? (Length (Map + (Cardinals) (Cardinals))) #f)75 (not (Length (Cardinals))) 76 (Eqv? (Map add1 (Firstfive)) (List 1 2 3 4 5)) 77 (Eqv? (Map + (Firstfive) (Take 5 (Cardinals))) 78 (List 0 2 4 6 8)) 79 (not (Length (Map + (Cardinals) (Cardinals)))) 78 80 (Foreach (lambda (x y) (print "### " x " " y)) (Cardinals) (Firstfive)) 79 81 (= (Length (Filter odd? (Firstfive))) 2) 80 (equal? (List>list (Filter odd? (Firstfive))) '(1 3)) 81 (eq? (Length (Filter odd? (Cardinals))) #f) 82 (= (Ref 20 (Sieve = (Zip (Cardinals) (Cardinals)))) 20) 83 (equal? (List>list (Sieve = (Zip (Firstfive) (Firstfive)))) 84 '(0 1 2 3 4)) 85 (= (Ref 25 (Cardinals)) 25) 86 (= (Ref 2 (Firstfive)) 2) 87 (equal? (List>list (Repeat 3 #f)) '(#f #f #f)) 82 (Eqv? (Filter odd? (Firstfive)) (List 1 3)) 83 (not (Length (Filter odd? (Cardinals)))) 84 (Eqv? (Take 10 (Zip (Firstfive) (Cardinals))) 85 (List 0 0 1 1 2 2 3 3 4 4)) 86 (not (Length (Zip (Firstfive) (Cardinals)))) 87 (= (At 20 (Sieve = (Zip (Cardinals) (Cardinals)))) 20) 88 (Eqv? (Sieve = (Zip (Firstfive) (Firstfive))) 89 (List 0 1 2 3 4)) 90 (= (At 25 (Cardinals)) 25) 91 (= (At 2 (Firstfive)) 2) 92 (Eq? (Repeat #f 3) (List #f #f #f)) 88 93 (Listinfinite? (Repeatedly (lambda () 1))) 89 ( equal? (List>list (Repeatedly 3 (lambda () 1)))90 '(1 1 1))94 (Eqv? (Repeatedly (lambda () 1) 3) 95 (List 1 1 1)) 91 96 (Listinfinite? (Iterate add1 0)) 92 (Listfinite? (Iterate 3 add1 0))93 ( equal? (List>list (Iterate 3 add1 0)) '(0 1 2))94 ( eq? (Length (Iterate add1 0)) #f)95 ( equal? (List>list (Cycle 10 (Firstfive)))96 '(0 1 2 3 4 0 1 2 3 4))97 ( eq? (Length (Cycle (Firstfive))) #f)97 (Listfinite? (Iterate add1 0 3)) 98 (Eqv? (Iterate add1 0 3) (List 0 1 2)) 99 (not (Length (Iterate add1 0))) 100 (Eqv? (Cycle 10 (Firstfive)) 101 (List 0 1 2 3 4 0 1 2 3 4)) 102 (not (Length (Cycle (Firstfive)))) 98 103 (= (Length (Append (Firstfive) (Firstfive))) 10) 99 104 (not (Length (Append (Cardinals) (Firstfive)))) 100 (equal? (List>list (Append (Firstfive) (Firstfive))) 101 '(0 1 2 3 4 0 1 2 3 4)) 102 (equal? (List>list (Take 12 (Append (Firstfive) (Cardinals)))) 103 '(0 1 2 3 4 0 1 2 3 4 5 6)) 104 (eq? (Length (Append (Firstfive) (Cardinals))) #f) 105 (equal? (List>list (Reverse (Firstfive))) '(4 3 2 1 0)) 106 (equal? (List>list (Reverse (Take 5 (Cardinals)))) '(4 3 2 1 0)) 105 (Eqv? (Append (Firstfive) (Firstfive)) 106 (List 0 1 2 3 4 0 1 2 3 4)) 107 (Eqv? (Take 12 (Append (Firstfive) (Cardinals))) 108 (List 0 1 2 3 4 0 1 2 3 4 5 6)) 109 (not (Length (Append (Firstfive) (Cardinals)))) 110 (Listfinite? (Reverse (Firstfive))) 111 (Listfinite? Nil) 112 (zero? (Length Nil)) 113 (Equ? = (Reverse (Firstfive)) (List 4 3 2 1 0)) 114 (Equ? = (Reverse (Take 5 (Cardinals))) (List 4 3 2 1 0)) 115 (= (Length (List 0 1 2 3 4)) 5) 107 116 (= (Length (Reverse (Firstfive))) 5) 108 ( eq? (Length (Reverse* (Cardinals))) #f)109 ( equal? (List>list (Ref 5 (Reverse* (Cardinals)))) '(5 4 3 2 1 0))110 ( equal? (List>list (Sort < (Firstfive))) '(0 1 2 3 4))117 (not (Length (Reverse* (Cardinals)))) 118 (Equal? (At 5 (Reverse* (Cardinals))) (List 5 4 3 2 1 0)) 119 (Equal? (At 4 (Reverse* (Firstfive))) (List 4 3 2 1 0)) 111 120 (Sorted? < (Firstfive)) 112 121 (not (Sorted? < (Append (Firstfive) (Firstfive)))) 122 (Equal? (Sort < (Firstfive)) (List 0 1 2 3 4)) 113 123 (= (Length (Sort < (Firstfive))) 5) 114 ( equal? (List>list (Sort < (List 3 1 0 2 4))) '(0 1 2 3 4))124 (Equal? (Sort < (List 3 1 0 2 4)) (List 0 1 2 3 4)) 115 125 (equal? 116 126 (receive (head tail) (Splitat 5 (Cardinals)) 117 127 (cons (First tail) (List>list head))) 118 128 '(5 0 1 2 3 4)) 119 (equal?120 (receive (head tail) (Splitat 15 (Take 5 (Cardinals)))121 (append (List>list tail) (List>list head)))122 '(0 1 2 3 4))123 129 "FOLDS" 130 (define (consright var lst) 131 (if (null? lst) 132 (cons var lst) 133 (cons (car lst) (consright var (cdr lst))))) 134 (equal? (consright 10 '(0 1 2 3)) '(0 1 2 3 10)) 124 135 (= (Foldleft + 0 (Take 5 (Cardinals))) 10) 125 136 (= (Foldleft + 0 (Firstfive) (Firstfive)) 20) … … 127 138 (equal? (Foldleft cons '() (Take 5 (Cardinals))) 128 139 '(((((() . 0) . 1) . 2) . 3) . 4)) 129 (equal? ( Ref4 (Foldleft* cons '() (Cardinals)))140 (equal? (At 4 (Foldleft* cons '() (Cardinals))) 130 141 '(((((() . 0) . 1) . 2) . 3) . 4)) 131 142 (= (Foldright + 0 (Take 5 (Cardinals))) 10) 132 143 (= (Foldright + 0 (Firstfive) (Firstfive)) 20) 133 144 (equal? (Foldright cons '() (Firstfive)) 134 '(0 1 2 3 4)) ; list145 '(0 1 2 3 4)) 135 146 (equal? (Foldright cons '(a b c) (Firstfive)) 136 147 '(0 1 2 3 4 a b c)) ; append 137 (equal? ( Ref4 (Foldright* cons '() (Cardinals)))148 (equal? (At 4 (Foldright* cons '() (Cardinals))) 138 149 '(4 3 2 1 0)) ; note changed order 139 (equal? ( Ref4 (Foldright* consright '() (Cardinals)))150 (equal? (At 4 (Foldright* consright '() (Cardinals))) 140 151 '(0 1 2 3 4)) 141 (equal? ( Ref4 (Foldright* cons '(a b c) (Cardinals)))152 (equal? (At 4 (Foldright* cons '(a b c) (Cardinals))) 142 153 '(4 3 2 1 0 a b c)) ; note changed order 143 (equal? ( Ref4 (Foldright* consright '(a b c) (Cardinals)))154 (equal? (At 4 (Foldright* consright '(a b c) (Cardinals))) 144 155 '(a b c 0 1 2 3 4)) 145 156 "TRANSFORMATIONS" 146 ( equal? (List>list (vector>List '#(0 1 2 3 4))) '(0 1 2 3 4))147 (Null? (vector>List '#()))148 (equal? (List>vector (Take 5 (Cardinals))) '#(0 1 2 3 4))149 (equal? (List>vector (Firstfive)) '#(0 1 2 3 4))157 (Equal? (vector>List #(0 1 2 3 4)) (List 0 1 2 3 4)) 158 (Null? (vector>List #())) 159 (equal? (List>vector (Take 5 (Cardinals))) #(0 1 2 3 4)) 160 (equal? (List>vector (Firstfive)) #(0 1 2 3 4)) 150 161 (equal? (List>vector Nil) '#()) 151 ( eq? (Every? odd? (Take 15 (Filter odd? (Cardinals)))) #t)152 ( eq? (Every? odd? (Take 15 (Cardinals))) #f)153 ( eq? (Every? odd? Nil) #t)154 ( eq? (Some? odd? Nil) #f)155 ( eq? (Some? odd? (Take 5 (Filter even? (Cardinals)))) #f)156 ( eq? (Some? odd? (Firstfive)) #t)162 (Every? odd? (Take 15 (Filter odd? (Cardinals)))) 163 (not (Every? odd? (Take 15 (Cardinals)))) 164 (Every? odd? Nil) 165 (not (Some? odd? Nil)) 166 (not (Some? odd? (Take 5 (Filter even? (Cardinals))))) 167 (Some? odd? (Firstfive)) 157 168 "ZIP AND UNZIP" 158 ( eq? (Length (Zip (Cardinals) (Firstfive))) #f)159 ( eq? (Length (Zip (Firstfive) (Cardinals))) #f)160 ( eq? (Length (Zip (Cardinals) (Cardinals))) #f)169 (not (Length (Zip (Cardinals) (Firstfive)))) 170 (not (Length (Zip (Firstfive) (Cardinals)))) 171 (not (Length (Zip (Cardinals) (Cardinals)))) 161 172 (= (Length (Zip (Firstfive) (Firstfive))) 10) 162 173 (Eqv? (Take 14 (Zip (Cardinals) (Firstfive))) … … 170 181 (Eqv? (Take 5 Odds) (List 1 3 5 7 9)))) 171 182 "PRIMES AND FIBS" 172 (= ( Ref50 (Primes)) 233)183 (= (At 50 (Primes)) 233) 173 184 (Eqv? (Take 5 (Primes)) (List 2 3 5 7 11)) 174 185 (Eqv? (Take 10 (Fibs)) (List 0 1 1 2 3 5 8 13 21 34)) 175 186 "LIST OF SUMS" 176 187 (define (Sums Lst) 177 (letrec ((sums (Cons 0 (Map + Lst (Lazy (Length Lst) sums))))) 178 (Rest sums))) 179 (equal? (List>list (Sums (Firstfive))) '(0 1 3 6 10)) 188 (let loop ((n 1)) 189 (Lazy #f (cons (apply + (List>list (Take n Lst))) 190 (loop (fx+ n 1)))))) 191 (Eqv? (Take 5 (Sums (Cardinals))) (List 0 1 3 6 10)) 180 192 "COMPUTE SQUARE ROOT BY NEWTON'S METHOD" 181 193 (define (Within eps Lst) 182 194 (let loop ((Lst Lst)) 183 (let ((a ( Ref 0 Lst)) (b (Ref1 Lst)))195 (let ((a (At 0 Lst)) (b (At 1 Lst))) 184 196 (if (< (abs ( a b)) eps) 185 197 b … … 187 199 (define (Relative eps Lst) 188 200 (let loop ((Lst Lst)) 189 (let ((a ( Ref 0 Lst)) (b (Ref1 Lst)))201 (let ((a (At 0 Lst)) (b (At 1 Lst))) 190 202 (if (<= (abs (/ a b)) (* (abs b) eps)) 191 203 b … … 201 213 (not (Listfinite? Integers)) 202 214 (not (Realized? Integers)) 203 (= ( Ref5 Integers) 6)215 (= (At 5 Integers) 6) 204 216 (Realized? Integers) 205 217 ))
Note: See TracChangeset
for help on using the changeset viewer.