home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e051 / 2.ddi / EXAMPLES / SIEVE.OPS < prev    next >
Encoding:
Text File  |  1987-06-12  |  2.7 KB  |  110 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; This production system implements the Sieve of Eratosthenes.  It
  3. ;;; uses a vector attribute to store the values of the primes as they
  4. ;;; are found.
  5.  
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;; data structures ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;
  9. ;;; (table n) (target n) (remove-mult x y z)
  10. ;;;
  11.     (literalize primes
  12.             current
  13.             prime-list)
  14.  
  15.     (vector-attribute prime-list)
  16.  
  17. ;;;;;;;;;;;;;;;;;;; Table Making ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18.  
  19. (p end-table  (table 1)
  20.           (target) 
  21.    -->
  22.     (remove 1)
  23.     (remove 2)
  24.     (make primes ^current 2 ^prime-list 1 ))
  25.  
  26. (p make-table  (target {<n> > 0})
  27.    -->
  28.     (make table <n>)
  29.     (modify 1 ^2 (compute <n> - 1)))
  30.  
  31. ;;;;;;;;;;;;;;;;;;; Find Primes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32.  
  33. (p last-prime     (primes ^current <x>) 
  34.         (to-num <= <x>)
  35.         -(table <x>)
  36.         -(remove-mult)
  37.     --> 
  38.     (make done-primes))
  39.  
  40. (p got-prime  (primes ^current <x>)
  41.           (table <x>)
  42.           -(remove-mult)
  43.    --> 
  44.     (remove 2)
  45.     (remove 1)
  46.     (make primes (compute (<x> + 1)) (substr 1 prime-list inf) <x>)
  47.     (make remove-mult (compute <x> * <x>)  <x> <x>))
  48.  
  49. (p not-prime  (primes ^current <x>) 
  50.           (to-num > <x>)
  51.           -(table <x>)
  52.           -(remove-mult)
  53.    --> 
  54.     (modify 1 ^current (compute <x> + 1)))
  55.  
  56. ;;;;;;;;;;;;;;;;;;; Remove Multiples ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57.  
  58. (p end-remove   (remove-mult <x>)
  59.         (to-num <= <x>) 
  60.    --> 
  61.     (remove 1))
  62.  
  63. (p mult-remove  (remove-mult <x> <y> <z>)
  64.         (table <x>)
  65.    --> 
  66.     (remove 2)
  67.     (remove 1)
  68.     (make remove-mult (compute (<y> * (<z> + 1))) <y> (compute (<z> + 1))))
  69.  
  70. (p incr-remove    (remove-mult <x> <y> <z>)
  71.         (to-num > <x>)
  72.         -(table <x>)
  73.    --> 
  74.     (remove 1)
  75.     (make remove-mult (compute (<y> * (<z> + 1))) <y> (compute (<z> + 1))))
  76.  
  77. ;;;;;;;;;;;;;;;;;;; I/O Productions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78.  
  79. (p output-results  (done-primes)
  80.            (to-num <y>)
  81.            (primes)
  82.     -->
  83.     (remove 1)
  84.     (remove 2)
  85.     (remove 3)
  86.     (write (crlf) "The Primes from 1 to " <y>  " are: "
  87.        (crlf) (substr 3 prime-list inf))
  88.     (make enter-to-num))
  89.  
  90. (p sieve-start  (start)
  91.    -->
  92.     (write "Program to compute the primes from 1 to a number entered"
  93.            (crlf) "by the user."
  94.            (crlf))
  95.     (remove 1)
  96.     (make enter-to-num))
  97.  
  98. (p sieve (enter-to-num) -->
  99.     (remove 1)
  100.     (write (crlf)
  101.        "Enter a positive number to compute the primes between"
  102.           (crlf)
  103.        "1 and that number, or enter a negative number or 0 to quit"
  104.            (crlf))
  105.     (bind <x> (accept))
  106.     (make to-num <x>)
  107.     (make target <x>))
  108.  
  109. ;;;;;;;;;;;;;;;;;;; end of productions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  110.