Changeset 27152 in project
 Timestamp:
 08/01/12 18:58:01 (9 years ago)
 File:

 1 copied
Legend:
 Unmodified
 Added
 Removed

wiki/eggref/4/lazylists
r27151 r27152 2 2 [[toc:]] 3 3 4 == contracts 5 6 === Design by Contract 7 8 "Design by contract" is a metaphor coined by Bertrand Meyer for his purely object oriented language Eiffel. The idea behind it is to separate the concerns of suppliers and clients of software modules: The client of a routine is responsible for calling it with correct arguments. The supplier can rely on it, she/he mustn't check it again. The supplier in turn is responsible for delivering correct results, provided the routine's arguments are valid. If not, the supplier needn't do any work at all. 9 10 In this metaphor a module is something like a contract between the supplier and the client of that module. But like a contract in social life, it's useless if not properly documented. Hence the "small print" of our module should be documented automatically, so that each party knows about each others duties .... 11 12 === Commandqueryseparation 13 14 Another metaphor of Meyer's is "commandqueryseparation", where in Eiffel a command is working by side effect (it changes the object's state) and a query is a pure function (it reports the object's state without changing it). His advice is, never to do both in one routine, write two instead. 15 16 === Implementation and use 17 18 This module is an attempt to bring Design by Contract to Chicken Scheme. In effect, it replaces define and definesyntax by new macros definewithcontract and definesyntaxwithcontract respectively, where  in the long form  the lambda or syntaxrules expression is preceeded by a contract expression. A short form is available as well, where the call pattern of the procedure is followed by the contract clauses and the procedure's body. 19 20 To achieve automatic documentation, these two macros have to be wrapped by a call of the parameter 21 22 <enscript highlight=scheme>(doclist '())</enscript> 23 24 initializing documentation and the definition 25 26 <enscript highlight=scheme>(define modulename (doclist>dispatcher (doclist)))</enscript> 27 28 saving it in a dispatcher routine. 29 30 ==== The case of procedures 31 32 For procedures a contract expression starts with the symbol contract and contains a list of clauses, where each clause is either 33 34 * the pattern of a typical procedure's call, the only required clause, 35 36 * a documentation string, 37 38 * a list starting with the keyword domain: (or the literal domain) and containing checks of the assumptions, 39 40 * a list starting with the keyword range: (or the literal range) followed either by (withresults (result0 result1 ...) xpr0 xpr1 ...) or by xpr0 xpr1 ..., where xpr0 xpr1 are predicates on result0 result1 ... or the default variable name result. 41 42 * a list starting with the keyword effect: (or the literal effect) which contains triples of the form (state query change [equ?]) where state is bound to the query expression before the command call and the change expression is compared with equal? [or equ?, if supplied] to another call of query after the command call. 43 44 Note, that commandqueryseparation demands, that only one of a range: and an effect: clause are allowed. 45 46 ==== The case of macros 47 48 For syntaxrules macros as well as irmacrorules and ermacrorules macros the contract expression is simply a docstring. After all, those macrotransformers have domain checks already builtin in form of the pattern matching process, it needs only be automatically documented. 49 50 For raw lowlevel macros based on (erir)macrotransformer, it's a list starting with the macro code (name . rest) which will be matched against the macro's use and an optional documentation string. 51 52 === Programming interface of module contracthelpers 53 54 ==== contracthelpers 55 56 <procedure>(contracthelpers [sym])</procedure> 57 58 prints the contract of the exported symbol sym of the contracthelpers module or the list of exported symbols when called as a thunk. 59 60 ==== ermacrorules 61 62 <syntax>(ermacrorules (%sym ...) (code0 xpr0) (code1 xpr1) ...)</syntax> 63 64 references a renamed version of sym ... under the name %sym ... and pairs the differnt macrocodes code0 code1 ... with expressions xpr0 xpr1 ..., which usually evalute to backquoted templates. 65 66 This macro is unhygienic by design, it introduces the symbol compare? into its scope. 67 68 ==== irmacrorules 69 70 <syntax>(irmacrorules (sym ...) (code0 xpr0) (code1 xpr1) ...)</syntax> 71 72 pairs the differnt macrocodes code0 code1 ... with expressions xpr0 xpr1 ..., which usually evalute to backquoted templates in the scope of injected symbols sym .... 73 74 This macro is unhygienic by design, it introduces the two symbols inject and compare? into its scope. 75 76 ==== bind 77 78 <syntax>(bind pat xpr . body)</syntax> 79 80 binds the pattern variables of the nested lambdalist pat to corresponding subexpressions of the nested pseudolist xpr and executes body in this context. 81 82 ==== bindcase 83 84 <syntax>(bindcase xpr (pat0 . body0) (pat1 . body1) ...)</syntax> 85 86 matches nested pseudolistexpression xpr against patterns pat0 pat1 ... in sequence, binding the variables of the first matching pattern to corresponding subexpressions of xpr and executes body of the first matching pattern in this context. 87 88 ==== doclist 89 90 <parameter>(doclist '())</parameter> 91 92 should be called before the first define[syntax]withcontract expression to initialize automatic documentation. 93 94 ==== doclist>dispatcher 95 96 <procedure>(doclist>dispatcher (doclist))</procedure> 97 98 saves (doclist) in a dispatcher. A typical use is 99 100 <enscript highlight=scheme> 101 (define modulename (doclist>dispatcher (doclist))) 102 </enscript> 103 104 which should be called after the last define[syntax]withcontract expression to save the automatic documentation in modulename. This procedure can than be called by the module's client with or without a symbol argument. 105 106 <enscript highlight=scheme> 107 (modulename [sym]) 108 </enscript> 109 110 Without argument the call returns the list of exported symbols, with argument the call returns the textual representaion of the contract of the module's exported symbol sym. 111 112 ==== printdoclist 113 114 <procedure>(printdoclist)</procedure> 115 116 prints the documentation of the whole module in readable form. 117 118 === Programming interface of module contracts 119 120 All exported symbols of contracthelpers are passed through, so that it's only necessary to import contracts. 121 122 ==== contracts 123 124 <procedure>(contracts [sym])</procedure> 125 126 prints the contract of the exported symbol sym of the contracts module or the list of exported symbols when called as a thunk. 127 128 ==== contract 129 130 <syntax>(contract (name . args) clause ...)</syntax> 131 132 where each clause is one of 133 134 * a documentation string 135 136 * {{(domain: assumption ...)}} 137 138 * {{(range: proposition ...) or (range: (withresults (res0 res1 ...) proposition ...)}} 139 140 * {{(effect: (state query change [equ?]) ...)}} 141 142 ==== definewithcontract 143 144 One of 145 146 <syntax>(definewithcontract name (contract (name . args) clause ...) (lambda args . body))</syntax> 147 148 <syntax>(definewithcontract name (let ((var val) ...) (contract (name . args) clause ...) (lambda args . body)))</syntax> 149 150 <syntax>(definewithcontract (name . args) clause ... . body)</syntax> 151 152 where the admissible clauses are described above and instead of let another binding construct can be used as well. 153 154 ==== definesyntaxwithcontract 155 156 One of 157 158 <syntax>(definesyntaxwithcontract name docstring rules)</syntax> 159 160 where rules is one of 161 162 * {{(syntaxrules (sym ...) (pat0 tpl0) (pat1 tpl1) ...)}} 163 164 * {{(irmacrorules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)}} 165 166 * {{(ermacrorules (%sym ...) (pat0 xpr0) (pat1 xpr1) ...)}} 167 168 and docstring is optional, 169 170 <syntax>(definesyntaxwithcontract name (syntaxcontract (name . rest) docstring) transformer)</syntax> 171 172 where docstring is optional and transformer is a raw lowlevel macrotransformer, 173 174 <syntax>(definesyntaxwithcontract (name . rest) docstring withexpression)</syntax> 175 176 where docstring is optional and withexpression is one of 177 178 * {{(literal syms . body)}} 179 180 * {{(withrenamed syms . body)}} 181 182 * {{(withinjected syms . body)}} 183 184 which will be translated to syntaxrules, ermacrorules or irmacrorules respectively. 185 186 ==== definemacrowithcontract 187 188 <syntax>(definemacrowithcontract code docstring body))</syntax> 189 190 where docstring is optional, code is the complete macrocode (name . args), i.e. the pattern of a macro call, and body is one of 191 192 (withrenamed (%sym ...) xpr . xprs) 193 (withinjected (sym ...) xpr . xprs) 194 xpr . xprs 195 196 In the first case each %sym is a renamed version of sym, in the second sym is injected as is, i.e. not renamed, and in the last case no symbol is injected, i.e. the macro is hygienic. 4 == Lazy lists 5 6 Lists in Scheme and Lisp are eager. Since the procedure calling regime 7 in these languages is "Call by value", a list argument of a procedure 8 call is completely constructed before the procedure is called. This is 9 fine for small lists, but it excludes practically the chaining of 10 procedure calls with large list arguments. On the other hand such a 11 chaining is a tremendously powerful modularization technique, as 12 demonstrated by purely functional languages like Haskell. 13 14 The traditional tools for implementation of lazy evaluation consist of 15 the two Scheme primitives delay and force (cf. the classic "Structure 16 and Interpretation of Computer Porgrams" by Abelson and Sussman, usually 17 abbreveated "SICP"). But there is a better method as shown by Moritz 18 Heidkamp in his lazyseq Module, which in turn is meant to replace the 19 stream datatype in SRFI41. Moritz' approach is inspired by the Lisp 20 dialect Clojure, which also motivated the beautiful macros in his 21 clojurian module. The fundamental idea is to store the structure of a 22 lazy list in a record, but to realize this list only as much as needed. 23 This way a large (even infinite) list can be created instantaneously 24 without realizing it and will be realized only if and as much as used. 25 26 This module is based on Heidkamp's implementation with one essential 27 addition: The length of the list is stored in the record and can thus be 28 referenced without realizing the whole list. After all, some operations 29 like reverse are only meaningful for finite lists, so one must know 30 beforehand if a list is finite to avoid infinite loops. 31 32 But knowing the length of a list at the moment of its creation, lazy 33 lists can replace ordinary lists as a datatype. And ordinary list 34 operations can be replaced by lazy list operations. This is the reason 35 for the other difference of this module with Moritz' lazyseq, a 36 cosmetic difference: Lazy list operations are named with the same name 37 as ordinary ones, only capitalized at the beginning. So Cons, Car, Cdr 38 ... are the replacements of cons, car, cdr etc. Some operators have a 39 different argument order, thow, so that the clojurian chaining macro >> 40 works well. The consistent argument order is as follows: procedure 41 argument appear first, lazy list arguments last. For example (Ref n seq) 42 replaces (listref seq n), (Drop n seq) replaces (listtail seq n), etc. 43 44 Storing the length in the list record has another advantage: I can and 45 will use my own contracts module to guard the implementation of the 46 routines by contracts, i.e. pre and postconditions. This allows to 47 implement the routines proper without any defences  this is done in the 48 module %lazylists  and wrap each call with the contract in the 49 lazylists module. In other words, both modules have exactly the same 50 interface (with one exception: the documentation procedure lazylists in 51 the latter). The routines of the former are imported into the latter 52 with the prefix %, so that they can be used there without contracts. 53 54 Remember, that modules written in the designbycontract style have 55 their documentation included, namely the equally named procedure 56 57 === lazylists 58 59 <enscript highlight=scheme> 60 (lazylists) 61 (lazylist 'List) 62 </enscript> 63 64 The first call returns all available routines, the second documentation 65 and contract of the symbol List 66 67 68 === makelazy 69 70 <enscript highlight=scheme> 71 (makelazy len thunk) 72 (domain (or (not len) (and (integer? len) (not (negative? len)))) (procedure? thunk) thunk returns either '(), a List or (cons val List)) 73 (range (%List? result) (= (%Length result) len)) 74 </enscript> 75 76 lazy constructor 77 78 === Lazy 79 80 <syntax> 81 (Lazy len xpr . xprs) 82 </syntax> 83 84 wrapper to makelazy constructor 85 86 87 === List? 88 89 <enscript highlight=scheme> 90 (List? xpr) 91 (range (boolean? result)) 92 </enscript> 93 94 lazy version of list? 95 96 === Length 97 98 <enscript highlight=scheme> 99 (Length seq) 100 (domain (%List? seq)) 101 (range (or (not result) (and (integer? result) (not (negative? result))))) 102 </enscript> 103 104 lazy version of length 105 106 === Cons 107 108 <enscript highlight=scheme> 109 (Cons var seq) 110 (domain (%List? seq)) 111 (range (%List? result) (or (not (%Length seq)) (= (%Length result) (+ (%Length seq) 1)))) 112 </enscript> 113 114 lazy version of cons 115 116 === Rest 117 118 <enscript highlight=scheme> 119 (Rest seq) 120 (domain (%List? seq) (not (%Null? seq))) 121 (range (%List? result) (or (not (%Length seq)) (= (%Length result) ( (%Length seq) 1)))) 122 </enscript> 123 124 lazy version of cdr 125 126 === Cdr 127 128 <enscript highlight=scheme> 129 (Cdr seq) 130 (domain (%List? seq) (not (%Null? seq))) 131 (range (%List? result) (or (not (%Length seq)) (= (%Length result) ( (%Length seq) 1)))) 132 </enscript> 133 134 lazy version of cdr 135 136 === First 137 138 <enscript highlight=scheme> 139 (First seq) 140 (domain (%List? seq) (not (%Null? seq))) 141 </enscript> 142 143 lazy version of car 144 145 === Car 146 147 <enscript highlight=scheme> 148 (Car seq) 149 (domain (%List? seq) (not (%Null? seq))) 150 </enscript> 151 152 lazy version of car 153 154 === Ref 155 156 <enscript highlight=scheme> 157 (Ref n seq) 158 (domain (%List? seq) (integer? n) (or (not (%Length seq)) (< 1 n (%Length seq)))) 159 </enscript> 160 161 lazy version of listref with changed argument order 162 163 === Null? 164 165 <enscript highlight=scheme> 166 (Null? seq) 167 (domain (%List? seq)) 168 (range (boolean? result)) 169 </enscript> 170 171 lazy version of null? 172 173 === Zip 174 175 <enscript highlight=scheme> 176 (Zip seq1 seq2) 177 (domain (%List? seq1) (%List? seq2)) 178 (range (%List? result) (if (and (%Length seq1) (%Length seq2)) (= (%Length result) (+ (%Length seq1) (%Length seq2))) (not (%Length result)))) 179 </enscript> 180 181 interleave two lazy lists 182 183 === Some? 184 185 <enscript highlight=scheme> 186 (Some? ok? seq) 187 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 188 </enscript> 189 190 does some item of seq fulfill ok? 191 192 === Every? 193 194 <enscript highlight=scheme> 195 (Every? ok? seq) 196 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 197 </enscript> 198 199 does every item of seq fulfill ok? 200 201 === Foldright* 202 203 <enscript highlight=scheme> 204 (Foldright* op base . seqs) 205 (domain (procedure? op) "(op b . ss)" ((listof? %List?) seqs) (or (null? seqs) (all (lambda (x) (eqv? (%Length x) (%Length (car seqs)))) (cdr seqs)))) 206 (range (%List? result) (if (null? seqs) (not (%Length result)) (eqv? (%Length result) (%Length (car seqs))))) 207 </enscript> 208 209 create a lazy list of right folds changing order or List items 210 211 === Foldleft* 212 213 <enscript highlight=scheme> 214 (Foldleft* op base . seqs) 215 (domain (procedure? op) "(op b . ss)" ((listof? %List?) seqs) (or (null? seqs) (all (lambda (x) (eqv? (%Length x) (%Length (car seqs)))) (cdr seqs)))) 216 (range (%List? result) (if (null? seqs) (not (%Length result)) (eqv? (%Length result) (%Length (car seqs))))) 217 </enscript> 218 219 create a lazy list of left folds 220 221 === Foldright 222 223 <enscript highlight=scheme> 224 (Foldright op base seq . seqs) 225 (domain (procedure? op) "(op b s . ss)" (%List? seq) ((listof? %List?) seqs) (%Length seq) (all (lambda (x) (= (%Length x) (%Length seq))) seqs)) 226 </enscript> 227 228 lazy version of foldright 229 230 === Foldleft 231 232 <enscript highlight=scheme> 233 (Foldleft op base seq . seqs) 234 (domain (procedure? op) "(op b s . ss)" (%List? seq) ((listof? %List?) seqs) (%Length seq) (all (lambda (x) (= (%Length x) (%Length seq))) seqs)) 235 </enscript> 236 237 lazy version of foldleft 238 239 === Sieve 240 241 <enscript highlight=scheme> 242 (Sieve =? seq) 243 (domain (%List? seq) (procedure? =?) "(=? a b)") 244 (range (%List? result) not two items =? (if (%Length seq) (<= (%Length result) (%Length seq)) (not (%Length result)))) 245 </enscript> 246 247 sieve of Erathostenes with respect to =? 248 249 === Splitwith 250 251 <enscript highlight=scheme> 252 (Splitwith ok? seq) 253 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 254 (range (withresults (head index tail) (%List? head) (%List? tail) (integer? index) (not (negative? index)) (<= (%Length head) (%Length seq)) (<= (%Length tail) (%Length seq)))) 255 </enscript> 256 257 split a lazy list at first index fulfilling ok? 258 259 === Splitat 260 261 <enscript highlight=scheme> 262 (Splitat n seq) 263 (domain (%List? seq) (integer? n) (not (negative? n))) 264 (range (withresults (head tail) (%List? head) (%Length head) (<= (%Length head) n) (%List? tail) (if (%Length seq) (<= (%Length tail) (%Length seq)) (not (%Length tail))))) 265 </enscript> 266 267 split a List at fixed position 268 269 === List>vector 270 271 <enscript highlight=scheme> 272 (List>vector seq) 273 (domain (%List? seq) (%Length seq)) 274 (range (vector? result) (eqv? (vectorlength result) (%Length seq))) 275 </enscript> 276 277 transform a finite lazy list into a vector 278 279 === vector>List 280 281 <enscript highlight=scheme> 282 (vector>List vec) 283 (domain (vector? vec)) 284 (range (%List? result) (eqv? (%Length result) (vectorlength vec))) 285 </enscript> 286 287 transform a vector into a lazy list 288 289 === Sort 290 291 <enscript highlight=scheme> 292 (Sort <? seq) 293 (domain (procedure? <?) "(<? a b)" (%List? seq) (%Length seq)) 294 (range (%List? result) "<? sorted" (eqv? (%Length result) (%Length seq))) 295 </enscript> 296 297 sort a finite lazy list with respect to <? 298 299 === Merge 300 301 <enscript highlight=scheme> 302 (Merge <? seq1 seq2) 303 (domain (procedure? <?) "(<? a b)" (%List? seq1) (%Length seq1) <? sorted (%List? seq2) (%Length seq2) <? sorted) 304 (range (%List? result) "<? sorted" (= (%Length result) (+ (%Length seq1) (%Length seq2)))) 305 </enscript> 306 307 merge two sorted lazy lists with respect to <? 308 309 === Cycle 310 311 <enscript highlight=scheme> 312 (Cycle seq) 313 (domain (%List? seq) (%Length seq)) 314 (range (%List? result) (not (%Length result))) 315 </enscript> 316 317 create infinite List by cycling finite List seq 318 319 === Reverse* 320 321 <enscript highlight=scheme> 322 (Reverse* seq) 323 (domain (%List? seq)) 324 (range (%List? result) (eqv? (%Length result) (%Length seq))) 325 </enscript> 326 327 List of successive reversed subLists 328 329 === Reverse 330 331 <enscript highlight=scheme> 332 (Reverse seq) 333 (domain (%List? seq) (%Length seq)) 334 (range (%List? result) (%Length result) (= (%Length result) (%Length seq))) 335 </enscript> 336 337 lazy version of reverse 338 339 === Append 340 341 <enscript highlight=scheme> 342 (Append . seqs) 343 (domain ((listof? %List?) seqs) (let ((lst (memv #f (map %Length seqs)))) (or (not lst) (<= (length lst) 1)))) 344 (range (%List? result) (or (not (%Length result)) (= (%Length result) (apply + (map %Length seqs))))) 345 </enscript> 346 347 lazy version of append 348 349 === Iterate 350 351 <enscript highlight=scheme> 352 (Iterate proc x) 353 (domain (procedure? proc) "(proc x)") 354 (range (%List? result) (not (%Length result))) 355 </enscript> 356 357 create infinite List by applying proc succesively to x 358 359 === Repeatedly 360 361 <enscript highlight=scheme> 362 (Repeatedly thunk) 363 (domain (procedure? thunk)) 364 (range (%List? result) (not (%Length result))) 365 </enscript> 366 367 create infinite List of return values of thunk 368 369 === Repeat 370 371 <enscript highlight=scheme> 372 (Repeat x) 373 (range (%List? result) (not (%Length result))) 374 </enscript> 375 376 create infinite List of x 377 378 === input>List 379 380 <enscript highlight=scheme> 381 (input>List port readproc) 382 (domain (inputport? port) (procedure? readproc)) 383 (range (%List? result) (%Length result)) 384 </enscript> 385 386 transform input port into List with readproc 387 388 === Foreach 389 390 <enscript highlight=scheme> 391 (Foreach proc seq . seqs) 392 (domain (%List? seq) ((listof? %List?) seqs) (procedure? proc) "(proc arg . args)" (all (lambda (x) (eqv? (%Length x) (%Length seq))) seqs)) 393 </enscript> 394 395 lazy version of foreach 396 397 === Filter 398 399 <enscript highlight=scheme> 400 (Filter ok? seq) 401 (domain (%List? seq) (procedure? ok?) "(ok? x)") 402 (range (%List? result) (or (not (%Length seq)) (<= (%Length result) (%Length seq)))) 403 </enscript> 404 405 lazy version of filter 406 407 === Map 408 409 <enscript highlight=scheme> 410 (Map proc seq . seqs) 411 (domain (%List? seq) ((listof? %List?) seqs) (procedure? proc) "(proc arg . args)" (all (lambda (x) (eqv? (%Length x) (%Length seq))) seqs)) 412 (range (%List? result) (eqv? (%Length result) (%Length seq))) 413 </enscript> 414 415 lazy version of map 416 417 === Assoc 418 419 <enscript highlight=scheme> 420 (Assoc key aseq) 421 (domain (%List? aseq) List of pairs (%Length aseq)) 422 (range (or (not result) (pair? result))) 423 </enscript> 424 425 lazy version of assoq 426 427 === Assv 428 429 <enscript highlight=scheme> 430 (Assv key aseq) 431 (domain (%List? aseq) List of pairs (%Length aseq)) 432 (range (or (not result) (pair? result))) 433 </enscript> 434 435 lazy version of assv 436 437 === Assq 438 439 <enscript highlight=scheme> 440 (Assq key aseq) 441 (domain (%List? aseq) List of pairs (%Length aseq)) 442 (range (or (not result) (pair? result))) 443 </enscript> 444 445 lazy version of assq 446 447 === Assp 448 449 <enscript highlight=scheme> 450 (Assp ok? aseq) 451 (domain (%List? aseq) List of pairs (%Length aseq) (procedure? ok?) "(ok? x)") 452 (range (or (not result) (pair? result))) 453 </enscript> 454 455 return #f or first pair, whose Car fulfills ok? 456 457 === Equal? 458 459 <enscript highlight=scheme> 460 (Equal? seq1 seq2) 461 (domain (%List? seq1) (%List? seq2)) 462 (range (boolean? result)) 463 </enscript> 464 465 lazy version of equal? 466 467 === Eqv? 468 469 <enscript highlight=scheme> 470 (Eqv? seq1 seq2) 471 (domain (%List? seq1) (%List? seq2)) 472 (range (boolean? result)) 473 </enscript> 474 475 lazy version of eqv? 476 477 === Eq? 478 479 <enscript highlight=scheme> 480 (Eq? seq1 seq2) 481 (domain (%List? seq1) (%List? seq2)) 482 (range (boolean? result)) 483 </enscript> 484 485 lazy version of eq? 486 487 === Equ? 488 489 <enscript highlight=scheme> 490 (Equ? =? seq1 seq2) 491 (domain (%List? seq1) (%List? seq2) (procedure? =?) "(=? x y)") 492 (range (boolean? result)) 493 </enscript> 494 495 compare two Lists with predicate =? 496 497 === Member 498 499 <enscript highlight=scheme> 500 (Member var seq) 501 (domain (%List? seq) (%Length seq)) 502 (range (%List? result) (<= (%Length result) (%Length seq))) 503 </enscript> 504 505 lazy version of member 506 507 === Memv 508 509 <enscript highlight=scheme> 510 (Memv var seq) 511 (domain (%List? seq) (%Length seq)) 512 (range (%List? result) (<= (%Length result) (%Length seq))) 513 </enscript> 514 515 lazy version of memv 516 517 === Memq 518 519 <enscript highlight=scheme> 520 (Memq var seq) 521 (domain (%List? seq) (%Length seq)) 522 (range (%List? result) (<= (%Length result) (%Length seq))) 523 </enscript> 524 525 lazy version of memq 526 527 === Memp 528 529 <enscript highlight=scheme> 530 (Memp ok? seq) 531 (domain (%List? seq) (%Length seq) (procedure? ok?) (ok? x)) 532 (range (%List? result) (<= (%Length result) (%Length seq))) 533 </enscript> 534 535 Tail of items not fulfilling ok? 536 537 === Index 538 539 <enscript highlight=scheme> 540 (Index ok? seq) 541 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 542 (range (integer? result) (not (negative? result))) 543 </enscript> 544 545 return index of first item fulfilling ok? 546 547 === Dropupto 548 549 <enscript highlight=scheme> 550 (Dropupto ok? seq) 551 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 552 (range (%List? result) (<= (%Length result) (%Length seq))) 553 </enscript> 554 555 Tail of items not fulfilling ok? 556 557 === Takeupto 558 559 <enscript highlight=scheme> 560 (Takeupto ok? seq) 561 (domain (%List? seq) (%Length seq) (procedure? ok?) "(ok? x)") 562 (range (%List? result) (<= (%Length result) (%Length seq))) 563 </enscript> 564 565 List of head items fulfilling ok? 566 567 === Drop 568 569 <enscript highlight=scheme> 570 (Drop n seq) 571 (domain (%List? seq) (integer? n) (not (negative? n))) 572 (range (%List? result) (if (%Length seq) (= (%Length result) (max 0 ( (%Length seq) n))) (not (%Length result)))) 573 </enscript> 574 575 lazy version of listtail with changed argument order 576 577 === Take 578 579 <enscript highlight=scheme> 580 (Take n seq) 581 (domain (%List? seq) (integer? n) (not (negative? n))) 582 (range (%List? result) (%Length result) (if (%Length seq) (= (%Length result) (min n (%Length seq))) (= (%Length result) n))) 583 </enscript> 584 585 List of first n items of seq 586 587 === List 588 589 <enscript highlight=scheme> 590 (List . args) 591 (range (%List? result) (eqv? (%Length result) (length args))) 592 </enscript> 593 594 lazy version of list 595 596 === list>List 597 598 <enscript highlight=scheme> 599 (list>List lst) 600 (domain (list? lst)) 601 (range (%List? result) (eqv? (%Length result) (length lst))) 602 </enscript> 603 604 transform ordinary list into finite lazy list 605 606 === List>list 607 608 <enscript highlight=scheme> 609 (List>list seq) 610 (domain (%List? seq) (%Length seq)) 611 (range (list? result)) 612 </enscript> 613 614 transform finite lazy into ordinary list 615 616 === Realized? 617 618 <enscript highlight=scheme> 619 (Realized? seq) 620 (domain (%List? seq)) 621 (range (boolean? result)) 622 </enscript> 623 624 Is seq realized? 625 626 === Primes 627 628 <enscript highlight=scheme> 629 (Primes) 630 (range (%List? result) (not (%Length result))) 631 </enscript> 632 633 lazy list of non prime numbers 634 635 === Cardinals 636 637 <enscript highlight=scheme> 638 (Cardinals) 639 (range (%List? result) (not (%Length result))) 640 </enscript> 641 642 lazy list of non negative integers 643 644 === Interval 645 646 <enscript highlight=scheme> 647 (Interval from upto) 648 (domain (integer? from) (integer? upto)) 649 (range (%List result) (= (%Length result) (abs ( upto from)))) 650 </enscript> 651 652 List of integers from (included) upto (excluded) 197 653 198 654 == Usage 199 655 200 656 <enscript highlight=scheme> 201 (use contracts) 202 (importforsyntax 203 (only contacts ermacrorules irmacrorules)) 204 </enscript> 657 658 (use lazylists contracts) 205 659 206 660 == Examples … … 208 662 <enscript highlight=scheme> 209 663 210 (use contacts) 211 212 (importforsyntax 213 (only contracts irmacrorules ermacrorules)) 214 215 ;;; initialize documentation 216 (doclist '()) 217 218 ;;; a single datatype as an alternative to boxes 219 220 ;; predicate 221 (definewithcontract (single? xpr) 222 "check, if xpr evaluates to a single" 223 (and (procedure? xpr) 224 (conditioncase (eq? 'single (xpr (lambda (a b c) a))) 225 ((exn) #f)))) 226 227 ;; constructor 228 (definewithcontract (single xpr) 229 "package the value of xpr into a single object" 230 (domain: (true? xpr)) 231 (range: (single? result)) 232 (lambda (sel) 233 (sel 'single xpr (lambda (new) (set! xpr new))))) 234 235 ;; query 236 (definewithcontract (singlestate sg) 237 "returns the state of the single object sg" 238 (domain: (single? sg)) 239 (range: (true? result)) 240 (sg (lambda (a b c) b))) 241 242 ;; command 243 (definewithcontract (singlestate! sg arg) 244 "replaces state of sg with arg" 245 (domain: (single? sg) (true? arg)) 246 (effect: (state (singlestate sg) arg)) 247 ((sg (lambda (a b c) c)) arg)) 248 249 ;;; Euclid's integer division as an example for a 250 ;;; function with two results 251 252 (definewithcontract (quotient+remainder m n) 253 "integer division" 254 (domain: 255 (integer? m) 256 (not (negative? m)) 257 (integer? n) 258 (positive? n) 259 (<= n m)) 260 (range: 261 (withresults (q r) 262 (integer? q) 263 (integer? r) 264 (= (+ (* q n) r) m))) 265 (let loop ((q 0) (r m)) 266 (if (< r n) 267 (values q r) 268 (loop (add1 q) ( r n))))) 269 270 ;;; the same trivial freeze macro implemented in different styles 271 272 (definesyntaxwithcontract (sefreeze xpr) 273 "sefreeze" 274 (withrenamed (%lambda) `(,%lambda () ,xpr))) 275 276 (definesyntaxwithcontract (sifreeze xpr) 277 "sifreeze" 278 (withinjected () `(lambda () ,xpr))) 279 280 (definesyntaxwithcontract (ssfreeze xpr) 281 "ssfreeze" 282 (literal () (lambda () xpr))) 283 284 (definesyntaxwithcontract sfreeze 285 "sfreeze" 286 (syntaxrules () 287 ((_ xpr) (lambda () xpr)))) 288 289 (definesyntaxwithcontract ifreeze 290 "ifreeze" 291 (irmacrorules () 292 ((_ xpr) `(lambda () ,xpr)))) 293 294 (definesyntaxwithcontract efreeze 295 "efreeze" 296 (ermacrorules (%lambda) 297 ((_ xpr) `(,%lambda () ,xpr)))) 298 299 (definesyntaxwithcontract lifreeze 300 (syntaxcontract (lifreeze xpr) "lifreeze") 301 (irmacrotransformer 302 (lambda (f i c) `(lambda () ,(cadr f))))) 303 304 (definesyntaxwithcontract lefreeze 305 (syntaxcontract (lefreeze xpr) "lefreeze") 306 (ermacrotransformer 307 (lambda (f r c) `(,(r 'lambda) () ,(cadr f))))) 308 309 (definesyntaxwithcontract lfreeze 310 (syntaxcontract (lfreeze xpr) "lfreeze") 311 (lambda (f r c) `(,(r 'lambda) () ,(cadr f)))) 312 313 ;;; explicit and implicitrenaming versions of or 314 315 (definesyntaxwithcontract eror 316 "erversion of or" 317 (ermacrorules (%if %eror) 318 ((_) #f) 319 ((_ arg . args) 320 `(,%if ,arg ,arg (,%eror ,@args))))) 321 322 (definesyntaxwithcontract iror 323 "irversion of or" 324 (irmacrorules () 325 ((_) #f) 326 ((_ arg . args) 327 `(if ,arg ,arg (iror ,@args))))) 328 329 (definemacrowithcontract (ouror . args) 330 "a private version of or" 331 (if (null? args) 332 #f 333 (let ((tmp (car args))) 334 `(if ,tmp ,tmp (ouror ,@(cdr args)))))) 335 336 (definemacrowithcontract (myor . args) 337 "a variant of or" 338 (withrenamed (%if %myor) 339 (if (null? args) 340 #f 341 (let ((tmp (car args))) 342 `(,%if ,tmp ,tmp (,%myor ,@(cdr args))))))) 343 344 ;; save documantation in dispatcher 345 (define docs (doclist>dispatcher (doclist))) 346 347 ;; some bindingexamples with results 348 349 (bind x 1 x) ; > 1 350 351 (bind (x (y (z . u) v) . w) '(1 (2 (3) 4) 5 6) 352 (list x y z u v w)) ; > (1 2 3 () 4 (5 6)) 353 354 (bind (x (y (z . u) v) . w) '(1 (2 (3 . 3) 4) 5 6) 355 (list x y z u v w)) ; > (1 2 3 3 4 (5 6)) 356 357 (bindcase '(1 (2 3)) 358 ((x (y z)) (list x y z)) 359 ((x (y . z)) (list x y z)) 360 ((x y) (list x y))) ; > (1 2 3) 361 362 (bindcase '(1 (2 3)) 363 ((x (y . z)) (list x y z)) 364 ((x y) (list x y)) 365 ((x (y z)) (list x y z))) ; > (1 2 (3)) 366 367 (bindcase '(1 (2 3)) 368 ((x y) (list x y)) 369 ((x (y . z)) (list x y z)) 370 ((x (y z)) (list x y z))) ; > (1 (2 3)) 371 372 (bindcase '(1 (2 . 3)) 373 ((x (y . z)) (list x y z)) 374 ((x (y z)) (list x y z))) ; > (1 2 3) 375 376 (bindcase '(1 (2 . 3)) 377 ((x y) (list x y)) 378 ((x (y . z)) (list x y z)) 379 ((x (y z)) (list x y z))) ; > (1 (2 . 3)) 664 665 (requirelibrary clojuriansyntax lazylists contracts) 666 (import lazylists clojuriansyntax contracts) 667 668 ;;; (run xpr0 xpr1 ...) 669 ;;;  670 (define (run . xprs) 671 (let loop ((xprs xprs)) 672 (if (null? xprs) 673 (print "All tests passed!") 674 (if (car xprs) 675 (loop (cdr xprs)) 676 (error 'run "#### Some test failed! ####"))))) 677 678 (define (consright var lst) 679 (if (null? lst) 680 (cons var lst) 681 (cons (car lst) (consright var (cdr lst))))) 682 683 (define (Within eps seq) 684 (let loop ((seq seq)) 685 (let ((a (Ref 0 seq)) (b (Ref 1 seq))) 686 (if (< (abs ( a b)) eps) 687 b 688 (loop (Rest seq)))))) 689 690 (define (Relative eps seq) 691 (let loop ((seq seq)) 692 (let ((a (Ref 0 seq)) (b (Ref 1 seq))) 693 (if (<= (abs (/ a b)) (* (abs b) eps)) 694 b 695 (loop (Rest seq)))))) 696 697 (define (Newton x) ; fixed point for square root 698 (lambda (a) (/ (+ a (/ x a)) 2))) 699 700 (define (Sums seq) ; List of sums 701 (letrec ((sums (Cons 0 (Map + seq (Lazy (Length seq) sums))))) 702 (Rest sums))) 703 704 (define (Firstfive) (List 0 1 2 3 4)) 705 (define (Fibs) 706 (Append (List 0 1) (Lazy #f (Map + (Rest (Fibs)) (Fibs))))) 707 708 (define port (openinputfile "lazylists.scm")) 709 (define input (input>List port readline)) 710 711 (run 712 (= (Length (Firstfive)) 5) 713 (= (Length (Rest (Firstfive))) 4) 714 (>> (Cardinals) (Rest) (Length) (eq? #f)) 715 (>> (Cardinals) (Take 5) (Length) (= 5)) 716 (>> (Cardinals) (Length) (eq? #f)) 717 (>> (Cardinals) (Drop 5) (Length) (eq? #f)) 718 (>> (Cardinals) (Drop 5) (First) (= 5)) 719 (>> (Firstfive) (List>list) (equal? '(0 1 2 3 4))) 720 (>> (Cardinals) (Take 5) (List>list) (equal? '(0 1 2 3 4))) 721 (>> (Interval 2 10) (Length) (= ( 10 2))) 722 (>> (Interval 2 10) (List>list) (equal? '(2 3 4 5 6 7 8 9))) 723 (>> (Interval 10 2) (List>list) (equal? '(10 9 8 7 6 5 4 3))) 724 (equal? 725 (receive (head index tail) (Splitwith (cut = <> 3) (Firstfive)) 726 (cons (First tail) (List>list head))) 727 '(3 0 1 2)) 728 (equal? 729 (receive (head index tail) (Splitwith (cut = <> 5) (Take 10 (Cardinals))) 730 (append (List>list tail) (List>list head))) 731 '(5 6 7 8 9 0 1 2 3 4)) 732 (>> (Firstfive) (Index (cut = <> 2)) (= 2)) 733 (>> (Firstfive) (Index (cut = <> 20)) (= 5)) 734 (>> (Cardinals) (Take 10) (Takeupto (cut = <> 5)) (List>list) 735 (equal? '(0 1 2 3 4))) 736 (>> (Cardinals) (Take 10) (Takeupto (cut = <> 5)) (Length) (= 5)) 737 (>> (Cardinals) (Take 10) (Dropupto (cut = <> 5)) (Length) (= 5)) 738 (>> (Cardinals) (Take 10) (Dropupto (cut = <> 5)) (First) (= 5)) 739 (>> (Firstfive) (Dropupto (cut = <> 2)) (Length) (= 3)) 740 (>> (Firstfive) (Dropupto (cut = <> 2)) (First) (= 2)) 741 (>> (Firstfive) (Memp odd?) (List>list) (equal? '(1 2 3 4))) 742 (>> (Cardinals) (Take 10) (Memv 5) (List>list) (equal? '(5 6 7 8 9))) 743 (>> (Cardinals) (Map (lambda (x) (list x x))) (Take 10) (Assv 5) 744 (equal? '(5 5))) 745 (>> (Firstfive) (Map (lambda (x) (list x x))) (Assv 10) 746 (eq? #f)) 747 (>> (Cardinals) (Equal? (Cardinals)) (eq? #f)) 748 (>> (Cardinals) (Equal? (Firstfive)) (eq? #f)) 749 (>> (Firstfive) (Equal? (Firstfive)) (eq? #t)) 750 (>> (Cardinals) (Take 10) (Length) (= 10)) 751 (>> (Cardinals) (Drop 1) (Filter odd?) (Take 5) (List>list) 752 (equal? '(1 3 5 7 9))) 753 (>> (Cardinals) (Length) (eq? #f)) 754 (>> (Firstfive) (Map add1) (List>list) (equal? '(1 2 3 4 5))) 755 (>> (Map + (Firstfive) (Take 5 (Cardinals))) (List>list) 756 (equal? '(0 2 4 6 8))) 757 (>> (Map + (Cardinals) (Cardinals)) (Length) (eq? #f)) 758 (>> (Filter odd? (Firstfive)) (Length) (= 2)) 759 (>> (Filter odd? (Firstfive)) (List>list) (equal? '(1 3))) 760 (>> (Filter odd? (Cardinals)) (Length) (eq? #f)) 761 (>> (Zip (Cardinals) (Cardinals)) (Sieve =) (Ref 20) (= 20)) 762 (>> (Zip (Firstfive) (Firstfive)) (Sieve =) (List>list) 763 (equal? '(0 1 2 3 4))) 764 (>> (Ref 25 (Cardinals)) (= 25)) 765 (>> (Ref 2 (Firstfive)) (= 2)) 766 (>> (Repeat #f) (Take 3) (List>list) (equal? '(#f #f #f))) 767 (>> (Repeatedly (lambda () 1))(Take 3) (List>list) 768 (equal? '(1 1 1))) 769 (>> (Iterate add1 0) (Take 3) (List>list) (equal? '(0 1 2))) 770 (>> (Iterate add1 0) (Length) (eq? #f)) 771 (>> (Append (Firstfive) (Firstfive)) (Length) (= 10)) 772 (>> (Append (Firstfive) (Firstfive)) (List>list) 773 (equal? '(0 1 2 3 4 0 1 2 3 4))) 774 (>> (Append (Firstfive) (Cardinals)) (Take 12) (List>list) 775 (equal? '(0 1 2 3 4 0 1 2 3 4 5 6))) 776 (>> (Append (Firstfive) (Cardinals)) (Length) (eq? #f)) 777 (>> (Firstfive) (Reverse) (List>list) (equal? '(4 3 2 1 0))) 778 (>> (Cardinals) (Take 5) (Reverse) (List>list) (equal? '(4 3 2 1 0))) 779 (>> (Firstfive) (Reverse) (Length) (= 5)) 780 (>> (Cardinals) (Reverse*) (Length) (eq? #f)) 781 (>> (Cardinals) (Reverse*) (Ref 5) (List>list) (equal? '(5 4 3 2 1 0))) 782 (>> (Cycle (Firstfive)) (Take 10) (List>list) 783 (equal? '(0 1 2 3 4 0 1 2 3 4))) 784 (>> (Cycle (Firstfive)) (Length) (eq? #f)) 785 (>> (Sort < (Firstfive)) (List>list) (equal? '(0 1 2 3 4))) 786 (>> (Sort < (Firstfive)) (Length) (= 5)) 787 (>> (Sort < (List 3 1 0 2 4)) (List>list) (equal? '(0 1 2 3 4))) 788 (equal? 789 (receive (head tail) (Splitat 5 (Cardinals)) 790 (cons (First tail) (List>list head))) 791 '(5 0 1 2 3 4)) 792 (equal? 793 (receive (head tail) (Splitat 15 (Take 5 (Cardinals))) 794 (append (List>list tail) (List>list head))) 795 '(0 1 2 3 4)) 796 (>> (Cardinals) (Take 5) (Foldleft + 0) (= 10)) 797 (>> (Foldleft + 0 (Firstfive) (Firstfive)) (= 20)) 798 (>> (List 1 2 3 4) (Foldleft * 1) (= 24)) 799 (>> (Cardinals) (Take 5) (Foldleft cons '()) 800 (equal? '(((((() . 0) . 1) . 2) . 3) . 4))) 801 (>> (Cardinals) (Foldleft* cons '()) (Ref 4) 802 (equal? '(((((() . 0) . 1) . 2) . 3) . 4))) 803 (>> (Cardinals) (Take 5) (Foldright + 0) (= 10)) 804 (>> (Foldright + 0 (Firstfive) (Firstfive)) (= 20)) 805 (>> (Firstfive) (Foldright cons '()) 806 (equal? '(0 1 2 3 4))) ; list 807 (>> (Firstfive) (Foldright cons '(a b c)) 808 (equal? '(0 1 2 3 4 a b c))) ; append 809 (>> (Cardinals) (Foldright* cons '()) (Ref 4) 810 (equal? '(4 3 2 1 0))) ; note changed order 811 (>> (Cardinals) (Foldright* consright '()) (Ref 4) 812 (equal? '(0 1 2 3 4))) 813 (>> (Cardinals) (Foldright* cons '(a b c)) (Ref 4) 814 (equal? '(4 3 2 1 0 a b c))) ; note changed order 815 (>> (Cardinals) (Foldright* consright '(a b c)) (Ref 4) 816 (equal? '(a b c 0 1 2 3 4))) 817 (>> (vector>List '#(0 1 2 3 4)) (List>list) (equal? '(0 1 2 3 4))) 818 (>> (vector>List '#()) (Null?)) 819 (>> (Take 5 (Cardinals)) (List>vector) (equal? '#(0 1 2 3 4))) 820 (>> (List>vector (Firstfive)) (equal? '#(0 1 2 3 4))) 821 (>> (List>vector Nil) (equal? '#())) 822 (>> (Filter odd? (Cardinals)) (Take 15) (Every? odd?) 823 (eq? #t)) 824 (>> (Take 15 (Cardinals)) (Every? odd?) 825 (eq? #f)) 826 (>> (Every? odd? Nil) (eq? #t)) 827 (>> (Some? odd? Nil) (eq? #f)) 828 (>> (Filter even? (Cardinals)) (Take 5) (Some? odd?) 829 (eq? #f)) 830 (>> (Some? odd? (Firstfive)) (eq? #t)) 831 (>> (Zip (Cardinals) (Firstfive)) (Length) (eq? #f)) 832 (>> (Zip (Firstfive) (Cardinals)) (Length) (eq? #f)) 833 (>> (Zip (Cardinals) (Cardinals)) (Length) (eq? #f)) 834 (>> (Zip (Cardinals) (Firstfive)) (Take 14) 835 (Eqv? (List 0 0 1 1 2 2 3 3 4 4 5 6 7 8))) 836 (>> (Zip (Cardinals) (Cardinals)) (Take 14) 837 (Eqv? (List 0 0 1 1 2 2 3 3 4 4 5 5 6 6))) 838 (>> (Zip (Firstfive) (Firstfive)) (Length) (= 10)) 839 (>> (Zip (Firstfive) (Firstfive)) 840 (Eqv? (List 0 0 1 1 2 2 3 3 4 4))) 841 (>> (Primes) (Ref 50) (= 233)) 842 (>> (Primes) (Take 5) (Eqv? (List 2 3 5 7 11))) 843 (>> (Fibs) (Take 10) (Eqv? (List 0 1 1 2 3 5 8 13 21 34))) 844 ;; compute square root 845 (let ((eps 0.000001)) 846 (< (abs ( (sqrt 2) (Within eps (Iterate (Newton 2) 2)))) eps)) 847 (>> (Firstfive) (Sums) (List>list) (equal? '(0 1 3 6 10))) 848 ) 380 849 381 850 </enscript> … … 387 856 == Initial version 388 857 389 Jun, 2011 858 Aug 1, 2012 390 859 391 860 == Updated 392 861 393 May 18, 2012394 395 862 == License 396 863 397 Copyright (c) 201 1, Juergen Lorenz864 Copyright (c) 2012, Juergen Lorenz 398 865 All rights reserved. 399 866 … … 408 875 == Version History 409 876 410 ; 2.0.4 : internal macro checkem corrected, message arguments in assert now strings 411 ; 2.0 : (erir)macrodefinewithcontract unified to definemacrowithcontract 412 ; 1.9 : withaliases and matches? removed from interface, bind and bindcase rewritten 413 ; 1.8 : Code split into two modules, added matches? withaliases ermacrodefinewithcontract irmacrodefinewithcontract 414 ; 1.7 : Code fixed to work with new transformer syntax in Chicken4.7.3, syntaxcontract removed as separate macro but retained as literal symbol in definesyntaxwithcontract, definesyntaxwithcontract rewritten 415 ; 1.6 : bind and bindcase exported again: needed by irmacros and ermacros 416 ; 1.5 : removed bind, bindcase rewritten but removed from interface 417 ; 1.4 : various chenges: removed unnecessary dependencies, removed bindlet* and matches? from interface, definesyntaxwithcontract and bind rewritten, comments updated, ... 418 ; 1.3 : changed withliteral to literal 419 ; 1.2 : added bind bindlet* bindcase matches syntaxcontract irmacrorules ermacrorules, changed definesyntaxwithcontract 420 ; 1.1 : (results: ...) made obsolete, use (withresults (name ...) . body) within (range: ...) instead 421 ; 1.0 : changed (effect: ...), removed (state: ...) (invariant: ...) 422 ; 0.4 : some enhancements 423 ; 0.3 : added {{printdoclist}}, fixed typo in setup script reported by mario 424 ; 0.2 : bugfixes 425 ; 0.1 : initial import 426 877 0.1 : initial import 878
Note: See TracChangeset
for help on using the changeset viewer.