Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | structure Stream = |
2 | struct | |
3 | datatype 'a u = Nil | Cons of 'a * 'a t | |
4 | withtype 'a t = unit -> 'a u | |
5 | ||
6 | fun unfold (f : 'b -> ('a * 'b) option) : 'b -> 'a t = | |
7 | let | |
8 | fun loop b () = | |
9 | case f b of | |
10 | NONE => Nil | |
11 | | SOME (x, b) => Cons (x, loop b) | |
12 | in | |
13 | loop | |
14 | end | |
15 | fun map (f : 'a -> 'b) : 'a t -> 'b t = | |
16 | unfold (fn s => | |
17 | case s () of | |
18 | Nil => NONE | |
19 | | Cons (x, xs) => SOME (f x, xs)) | |
20 | end | |
21 | ||
22 | structure PiDigits = | |
23 | struct | |
24 | fun stream (next : 'b -> 'c) | |
25 | (safe : 'b -> 'c -> bool) | |
26 | (prod : 'b -> 'c -> 'b) | |
27 | (cons : 'b -> 'a -> 'b) | |
28 | : 'b -> 'a Stream.t -> 'c Stream.t = | |
29 | let | |
30 | fun loop z s () = | |
31 | let | |
32 | val y = next z | |
33 | in | |
34 | if safe z y | |
35 | then Stream.Cons (y, loop (prod z y) s) | |
36 | else (case s () of | |
37 | Stream.Nil => Stream.Nil | |
38 | | Stream.Cons (x, xs) => loop (cons z x) xs ()) | |
39 | end | |
40 | in | |
41 | loop | |
42 | end | |
43 | ||
44 | type lft = (IntInf.int * IntInf.int * IntInf.int * IntInf.int) | |
45 | ||
46 | val unit : lft = (1,0,0,1) | |
47 | ||
48 | fun comp (q,r,s,t) (u,v,w,x) : lft = (q*u+r*w, q*v+r*x, s*u+t*w, s*v+t*x) | |
49 | ||
50 | val pi = | |
51 | let | |
52 | val init = unit | |
53 | val lfts = Stream.map (fn k => (k, 4*k+2, 0, 2*k+1)) (Stream.unfold (fn i => SOME (i, i+1)) 1) | |
54 | fun floor_extr (q,r,s,t) x = (q * x + r) div (s * x + t) | |
55 | fun next z = floor_extr z 3 | |
56 | fun safe z n = n = floor_extr z 4 | |
57 | fun prod z n = comp (10, ~10*n, 0, 1) z | |
58 | fun cons z z' = comp z z' | |
59 | in | |
60 | stream next safe prod cons init lfts | |
61 | end | |
62 | end | |
63 | ||
64 | structure MainShootout = | |
65 | struct | |
66 | fun display n = | |
67 | let | |
68 | fun loop (ds, (k, col)) = | |
69 | if k < n | |
70 | then let | |
71 | val col = | |
72 | if col = 10 | |
73 | then (print "\t:"; print (IntInf.toString k); print "\n"; | |
74 | 1) | |
75 | else col + 1 | |
76 | in | |
77 | case ds () of | |
78 | Stream.Nil => raise Empty | |
79 | | Stream.Cons (d, ds) => | |
80 | (print (IntInf.toString d); | |
81 | loop (ds, (k + 1, col))) | |
82 | end | |
83 | else (print (CharVector.tabulate (10 - col, fn _ => #" ")); | |
84 | print "\t:"; print (IntInf.toString k); print "\n"; | |
85 | ()) | |
86 | in | |
87 | loop (PiDigits.pi, (0, 0)) | |
88 | end | |
89 | fun usage name = | |
90 | (TextIO.output (TextIO.stdErr, | |
91 | concat ["usage: ", OS.Path.file name, " <n>\n"]); | |
92 | OS.Process.failure) | |
93 | fun main (name, arguments) = | |
94 | case arguments of | |
95 | [n] => (case IntInf.fromString n of | |
96 | SOME n => if n >= 1 | |
97 | then (display n; OS.Process.success) | |
98 | else usage name | |
99 | | NONE => usage name) | |
100 | | _ => usage name | |
101 | end | |
102 | (* | |
103 | val _ = OS.Process.exit (Main.main (CommandLine.name (), CommandLine.arguments ())) | |
104 | *) | |
105 | ||
106 | structure MainBenchmark = | |
107 | struct | |
108 | fun display n = | |
109 | let | |
110 | fun loop (ds, k, n) = | |
111 | case ds () of | |
112 | Stream.Nil => raise Empty | |
113 | | Stream.Cons (d, ds) => | |
114 | if d = 0 | |
115 | then if n = 0 | |
116 | then (print (IntInf.toString k); print "\n") | |
117 | else loop (ds, k + 1, n - 1) | |
118 | else loop (ds, k + 1, n) | |
119 | in | |
120 | loop (PiDigits.pi, 0, n) | |
121 | end | |
122 | fun usage name = | |
123 | (TextIO.output (TextIO.stdErr, | |
124 | concat ["usage: ", OS.Path.file name, " <n>\n"]); | |
125 | OS.Process.failure) | |
126 | fun main (name, arguments) = | |
127 | case arguments of | |
128 | [n] => (case IntInf.fromString n of | |
129 | SOME n => if n >= 1 | |
130 | then (display n; OS.Process.success) | |
131 | else usage name | |
132 | | NONE => usage name) | |
133 | | _ => usage name | |
134 | ||
135 | val doit = display o IntInf.fromInt | |
136 | end | |
137 | ||
138 | structure Main = MainBenchmark |