home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / tests / general / lgint.icn < prev    next >
Text File  |  2001-12-06  |  6KB  |  219 lines
  1. #SRC: JCON
  2. #OPT: -fe
  3.  
  4. # test large integer calculations
  5.  
  6. procedure main()
  7.    local a, b, primes
  8.    primes := [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37,
  9.       41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]
  10.  
  11.    write(); compiler()
  12.    write(); boundaries()
  13.    write(); every fact(1 to 55 by 11)
  14.    write(); every fib(35 to 341 by 34)
  15.    write(); every mersenne(61 | 89 | 107 | 127)
  16.    write(); every perfect(31 | 61 | 89 | 107)
  17.    write(); every power(11213, 2 to 16)
  18.    write(); every impower(3, 60 to 75)
  19.    write(); every minpower(!primes)
  20.    write(); every bigexp(3 | 6 | -7)
  21.    write(); every tmul(2 | 3 | 5 | 7 | 10 | 17 | 51 | -3 | -11 | -43)
  22.    write(); every tmul(3 ^ (2 to 50))
  23.    write(); every conv(787 ^ (1 to 24) | -5781 ^ (1 to 18))
  24.    write(); radix()
  25.    write(); over()
  26.  
  27.    # test unary and binary operations, including mixed-mode operations
  28.    a := [37, 5.0, 2 ^ 63, 11 ^ 19, 5 ^ 28]
  29.    b := [73, 9.0, -7 ^ 23, -(3 ^ 40), 17 ^ 16]
  30.    write(); every unops(!a | !b)
  31.    write(); every binops(!a, !b)
  32. end
  33.  
  34. procedure compiler()            # test compiler handling of lg constants
  35.    local a, b, c
  36.    a :=  1618033988749894848204586834365638117720309
  37.    b := -2718281828459045235360287471352662497757247
  38.    c := +3141592653589793238462643383279502884197169
  39.    write("    a =  ", a)
  40.    write("    b = ", b)
  41.    write("    c =  ", c)
  42.    write("a + b = ", a + b)
  43.    write("b + c =   ", b + c)
  44.    write("c + a =  ", c + a)
  45.    return
  46. end
  47.  
  48. procedure boundaries()            # test boundary cases
  49.    local minint, maxint
  50.    write("minint = ", minint := -(2^64))
  51.    write("maxint = ", maxint := 2^64 - 1)
  52.    write("-minint = ", -minint)
  53.    write("abs(min) = ", abs(minint))
  54.    write("minint * -1 = ", minint * -1)
  55.    write("minint / -1 = ", minint / -1)
  56.    write("(2^32)^2 = ", (2 ^ 32) ^ 2)
  57.    return
  58. end
  59.  
  60. procedure fact(n)            # factorial
  61.    local f
  62.    f := 1
  63.    every f *:= 2 to n
  64.    write(n, "! = ", f)
  65.    return
  66. end
  67.  
  68. procedure fib(n)            # fibonacci
  69.    local a, b, i, t
  70.    a := b := t := 1
  71.    every i := 3 to n do {
  72.       t := a + b
  73.       a := b
  74.       b := t
  75.       }
  76.    write("F(", n, ") = ", t)
  77.    return
  78. end
  79.  
  80. procedure power(b, n)            # simple power calculation
  81.    write(b, " ^ ", n, " = ", b ^ n)
  82.    return
  83. end
  84.  
  85. procedure impower(b, n)            # power calculation with image() test
  86.    write(b, " ^ ", n, " = ", image(b ^ n))
  87.    return
  88. end
  89.  
  90. procedure minpower(b)            # find minimum power that is a large int
  91.    local e
  92.    2 ^ 63 <= b ^ (e := seq(1))
  93.    write(right(b,2), " ^", right(e, 3), " =", right(b ^ e, 22))
  94. end
  95.  
  96. procedure bigexp(v)
  97.    local x
  98.    &error := -1
  99.    write("       v = ", v)
  100.    every x := (-2 to 2) | (-3 to 3) / 2.0 do 
  101.       write(right(x, 4), " ^ v = ", (x ^ v) | ("error " || &errornumber))
  102.    &error := 0
  103.    return
  104. end
  105.  
  106. procedure mersenne(m)            # Mersenne numbers
  107.    write("M(", m, ") = ", 2 ^ m - 1)
  108.    return
  109. end
  110.  
  111. procedure perfect(m)            # Mersenne perfect numbers
  112.    write("P(", m, ") = ", (2 ^ m - 1) * (2 ^ (m - 1)))
  113.    return
  114. end
  115.  
  116. procedure tmul(x)            # test multiply, divide, real(I)
  117.    local n, p, q, d, e
  118.  
  119.    p := 1
  120.    n := 0
  121.    while p < 1e25 do {
  122.       n +:= 1
  123.       q := p
  124.       p *:= x
  125.       d := p / q
  126.       e := real(p) / real(q)
  127.       err := abs(e / x - 1)
  128.       if not (d = x & err < 1.0e-14) then    # 1e-15 for most, 1e-14 for IBM
  129.          write(x, " ^ ", n, " = ", p, "\td=", d, "\te=", e, "\terr=", err)
  130.    }
  131.    write(x, " ^ ", n, " = ", p)
  132.    return
  133. end
  134.  
  135. procedure conv(n)            # test conversion to/from real & string
  136.    local sn, rn, in, d, r
  137.  
  138.    sn := string(n)
  139.    in := integer(sn)
  140.    if in ~= n then {
  141.       write("str conv err: n=", n, " sn=", sn, " in=", in)
  142.       return
  143.    }
  144.    rn := real(n)
  145.    in := integer(rn)
  146.    d := n - in
  147.    r := d / rn
  148.    if abs(r) > 1.0e-14 then        # 1e-15 works for most, need -14 for IBM
  149.       write("real conv err: n=", n, " rn=", rn, " in=", in, " d=", d, " r=", r)
  150.    else
  151.       write("conv ok: ", n)
  152.    return
  153. end
  154.  
  155. procedure unops(n)        # show results of unary ops and compares with 0
  156.    write("u:  ", n, "  ", -n, "  ", icom(n), compares(n, 0))
  157.    if abs(n) ~= (if n > 0 then n else -n) then write("  abs failure")
  158.    return
  159. end
  160.  
  161. procedure binops(m, n)        # show results of binary operations
  162.    write("b:  ", m, "  ", n, compares(m, n))
  163.    write("    +-   ", m + n, "  ", m - n)
  164.    write("    */%  ", m * n, "  ", m / n, "  ", m % n)
  165.    write("    &|!  ", iand(m, n), "  ", ior(m, n), "  ", ixor(m, n))
  166.    return
  167. end
  168.  
  169. procedure compares(m, n)    # return string indicating successful compares
  170.    local s
  171.    # == n validates value of comparison expr
  172.    s := " "
  173.    if (m < n)  == n then s ||:= " <"
  174.    if (m <= n) == n then s ||:= " <="
  175.    if (m = n)  == n then s ||:= " ="
  176.    if (m ~= n) == n then s ||:= " ~="
  177.    if (m > n)  == n then s ||:= " >"
  178.    if (m >= n) == n then s ||:= " >="
  179.    return s
  180. end
  181.  
  182. procedure radix()        # radix conversions
  183.    local b, s, d, min, n
  184.    min := 2 ^ 63
  185.    d := &digits || &lcase
  186.    every b := 2 to 35 do {
  187.       n := (min < integer(s := b || "R" || repl(d[b], 1 to 100)))
  188.       write(s, " = ", n)
  189.       }
  190.    every s := "36r" || repl("Z", 10 to 20) do
  191.       write(s, " = ", integer(s))
  192.    return
  193. end
  194.  
  195. procedure over()        # old "over.icn" test from Icon v9
  196.    local i
  197.  
  198.    if not(&features == "large integers") then
  199.       stop("large integers not supported")
  200.    i := 100000 + 10000
  201.    write(i)
  202.    i +:= 2 ^ 30
  203.    write(i)
  204.    i +:= i
  205.    write(i)
  206.    i := 100000 * 10000
  207.    write(i)
  208.    i +:= 2 ^ 30
  209.    write(i)
  210.    i *:= i
  211.    write(i)
  212.    i := -100000 - 10000
  213.    write(i)
  214.    i +:= -(2 ^ 30)
  215.    write(i)
  216.    i -:= 2 ^ 30
  217.    write(i)
  218. end
  219.