home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.05 May 91 / Lambda Code.text
Encoding:
Text File  |  1991-04-16  |  2.5 KB  |  138 lines  |  [TEXT/ttxt]
  1. ; File:  fact.y.
  2.  
  3. ; Here's the chosen function.
  4.  
  5. (define fact 
  6.   (lambda (n)
  7.     (if (zero? n)
  8.         1
  9.         (* n (fact (- n 1))))))
  10. ;
  11. (fact 5)
  12. ;
  13. (define identity
  14.   (lambda (x) x))
  15. ;
  16. (define project-1st-of-2
  17.   (lambda (x)
  18.     (lambda (y)
  19.       x)))
  20. ;
  21. (define project-2nd-of-2
  22.   (lambda (x)
  23.     identity))
  24. ;
  25. (define project-3rd-of-3
  26.   (lambda (x)
  27.     (lambda (y)
  28.       identity)))
  29. ;
  30. ;
  31. ; true and false could be defined this way:
  32. ;
  33. (define combinator-true
  34.   project-1st-of-2)
  35. ;
  36. (define combinator-false
  37.   project-2nd-of-2)
  38. ;
  39. ; but we'll do them as follows.
  40. ;
  41. (define combinator–true
  42.     (lambda (x)
  43.         (lambda (y)
  44.             x)))
  45.  
  46. ;
  47. (define combinator–false
  48.     (lambda (x)
  49.         (lambda (y)
  50.             y)))
  51.  
  52. ;
  53. (define combinator-cons
  54.   (lambda (x)
  55.     (lambda (y)
  56.       (lambda (selector)
  57.         ((selector x) y)))))
  58. ;
  59. (define combinator-car
  60.   (lambda (object)
  61.     (object project-1st-of-2)))
  62. ;
  63. (define combinator-cdr
  64.   (lambda (object)
  65.     (object project-2nd-of-2)))
  66. ;
  67. (define force-a-thunk
  68.   (lambda (thunk)
  69.     (thunk)))
  70. ;
  71. (define combinator-if
  72.   (lambda (condition)
  73.     (lambda (then)
  74.       (lambda (else)
  75.         (force-a-thunk ((condition then) else))))))
  76. ;
  77. (define combinator-zero
  78.   project-2nd-of-2)
  79. ;
  80. (define combinator-zero?
  81.   (lambda (n)
  82.     ((n project-3rd-of-3) combinator-true)))
  83. ;
  84. (define combinator-succ
  85.   (lambda (n)
  86.     (lambda (f)
  87.       (lambda (x)
  88.         (f ((n f) x))))))
  89. ;
  90. (define dechurchify-numeral
  91.   (lambda (numeral)
  92.     ((numeral 1+) 0)))
  93. ;
  94. (define make-church-numeral
  95.   (lambda (n)
  96.     (if (zero? n)
  97.         combinator-zero
  98.         (combinator-succ 
  99.          (make-church-numeral (- n 1))))))
  100. ;
  101. (define combinator-*
  102.   (lambda (m)
  103.     (lambda (n)
  104.       (lambda (f)
  105.         (m (n f))))))
  106. ;
  107. (define combinator-pred
  108.   (lambda (n)
  109.     (combinator-car 
  110.      ((n (lambda (tuple)
  111.            ((combinator-cons 
  112.              (combinator-cdr tuple))
  113.             (combinator-succ (combinator-cdr tuple)))))
  114.       ((combinator-cons "combinator-pred called on 0")
  115.        combinator-zero)))))
  116. ;
  117. (define combinator-applicative-order-y
  118.   (lambda (f)
  119.     ((lambda (x) (f (lambda (arg) ((x x) arg))))
  120.      (lambda (x) (f (lambda (arg) ((x x) arg)))))))
  121. ; 
  122. (define combinator-one
  123.   (make-church-numeral 1))
  124. ;
  125. (define combinator-fact
  126.   (combinator-applicative-order-y 
  127.    (lambda (fact)
  128.      (lambda (n)
  129.        (((combinator-if (combinator-zero? n))
  130.          (lambda () combinator-one))
  131.         (lambda () ((combinator-* n) 
  132.                     (fact (combinator-pred n)))))))))
  133. ;
  134. (dechurchify-numeral 
  135.  (combinator-fact (make-church-numeral 5)))
  136. ;
  137. ; Done.
  138.