scheme5.rkt 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. #lang racket
  2. (define saved-cont #f)
  3. (define (test-cont)
  4. (let ((x 0))
  5. (call/cc
  6. (lambda (k)
  7. (set! saved-cont k)))
  8. (set! x (+ x 1))
  9. (display x)
  10. (newline)))
  11. (define (iterate f v)
  12. (delay (cons v (iterate f (f v)))))
  13. (define (take n prom)
  14. (if (= n 0)
  15. '()
  16. (let ((v (force prom)))
  17. (cons (car v) (take (- n 1) (cdr v))))))
  18. (define (ftree treef treed)
  19. (cond
  20. ((null? treef) treed)
  21. ((list? treef) (cons (ftree (car treef) (car treed))
  22. (ftree (cdr treef) (cdr treed))))
  23. (else; should be atoms
  24. (treef treed))))
  25. (define (first x y) x)
  26. (define (infinity) (+ 1 (infinity)))
  27. (define lazy-infinity (delay (infinity)))
  28. (define (re-map f L cond?)
  29. (let loop ((res '())
  30. (cur L))
  31. (if (null? cur)
  32. res
  33. (let* ((k #f)
  34. (v (call/cc
  35. (lambda (cont)
  36. (set! k cont)
  37. (f (car cur))))))
  38. (if (cond? v)
  39. (cons k v)
  40. (loop (append res (list v))
  41. (cdr cur)))))))
  42. (struct cnode (value next) #:mutable)
  43. (define *end* '---end---)
  44. (define (cend)
  45. (let ((node (cnode *end* #f)))
  46. (set-cnode-next! node node)
  47. node))
  48. (define (ccons x node)
  49. (if (cend? node)
  50. (let ((out (cnode x #f)))
  51. (set-cnode-next! out node)
  52. (set-cnode-next! node out)
  53. out)
  54. (let ((the-end (get-end node))
  55. (out (cnode x node)))
  56. (set-cnode-next! the-end out)
  57. out)))
  58. (define (cend? clist)
  59. (and (cnode? clist)
  60. (eq? (cnode-value clist) *end*)))
  61. (define (get-end clist)
  62. (if (cend? clist)
  63. clist
  64. (get-end (cnode-next clist))))
  65. (define (cmap f clist)
  66. (if (cend? clist)
  67. (cend)
  68. (ccons (f (cnode-value clist))
  69. (cmap f (cnode-next clist)))))
  70. (define-syntax-rule (my-while condition body ...)
  71. (let loop ()
  72. (when condition
  73. body ...
  74. (loop))))
  75. (define (genFig n)
  76. (let loop ((f '())
  77. (k 0))
  78. (if (< k n)
  79. (loop (cons (genRow n k) f)
  80. (+ k 1))
  81. f)))
  82. (define (genRow n k)
  83. (let loop ((r '())
  84. (i 0))
  85. (if (< i n)
  86. (loop (cons (if (= i k) 1 0) r)
  87. (+ i 1))
  88. r)))