1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
4 * MLton is released under a BSD-style license.
5 * See the file MLton-LICENSE for details.
8 functor AlphaBeta (S: ALPHA_BETA_STRUCTS): ALPHA_BETA =
15 ("AlphaBeta.alphaBeta", State.layout, Value.layout, Value.layout, Value.layout)
23 ; if !numCalls = !next
26 val _ = next := 2 * !next
29 output (seq [str (Justify.justify (Int.toString (!numCalls),
35 ; Out.newline Out.error
43 val count = messenger ()
44 fun alphaBeta arg : Value.t =
46 (fn (s: State.t, a: Value.t, b: Value.t) =>
49 in align [tuple [Value.layout a, Value.layout b],
52 ; (case State.evaluate s of
56 else if Value.<= (b, v)
59 | State.NonLeaf {lower, upper} =>
60 if Value.<= (upper, a)
62 else if Value.<= (b, lower)
68 (* inv: a' <= b'' <= b' *)
70 if Value.equals (a', b'') then b''
75 loop (ss, alphaBeta (s, a', b''))
76 in Value.unmove (loop (State.succ s, b'))
82 val alphaBetaNoCache = alphaBeta
86 datatype t = T of {lower: Value.t,
89 fun layout (T {lower, upper}) =
90 if Value.equals (lower, upper)
91 then Value.layout lower
93 in seq [Value.layout lower, str "-", Value.layout upper]
99 fun make f (T r) = f r
101 val lower = make #lower
102 val upper = make #upper
105 val all = T {lower = Value.smallest,
106 upper = Value.largest}
108 fun above (v: Value.t): t = T {lower = v, upper = Value.largest}
110 fun below (v: Value.t): t = T {lower = Value.smallest, upper = v}
112 fun isPoint (T {lower, upper}) = Value.equals (lower, upper)
114 fun point v = T {lower = v, upper = v}
116 fun closest (T {lower, upper}, v: Value.t): Value.t =
117 if Value.<= (v, lower) then lower
118 else if Value.>= (v, upper) then upper
121 fun contains (T {lower, upper}, v: Value.t): bool =
122 Value.<= (lower, v) andalso Value.<= (v, upper)
124 fun move (T {lower, upper}): t =
125 T {lower = Value.move upper,
126 upper = Value.move lower}
128 fun intersect (i: t, i': t): t =
129 let val lower = Value.max (lower i, lower i')
130 val upper = Value.min (upper i, upper i')
131 in if Value.> (lower, upper)
132 then Error.bug "AlphaBeta.Interval.intersect: empty intersection"
133 else T {lower = lower, upper = upper}
135 (* val intersect = Trace.trace2 ("intersect", layout, layout, layout) intersect *)
139 * Trace.trace2 ("alphaBetaCache", State.layout, Interval.layout, Value.layout)
141 * fun traceAlphaBeta f (s, i) =
142 * let val v = trace f (s, i)
143 * val v' = alphaBetaNoCache (s, Interval.lower i, Interval.upper i)
144 * in if Value.equals (v, v')
146 * else Misc.bug (let open Layout
147 * in align [str "v = ", Value.layout v,
148 * str "v' = ", Value.layout v']
153 * val traceSearch = Trace.trace ("search", Interval.layout, Value.layout)
156 fun alphaBetaCache (s: State.t, i: Interval.t, c: Interval.t Cache.t): Value.t =
158 val count = messenger ()
159 fun alphaBeta (s: State.t, i: Interval.t): Value.t =
162 in align [Interval.layout i, State.layout s]
164 ; (case State.evaluate s of
165 State.Leaf v => Interval.closest (i, v)
166 | State.NonLeaf {lower, upper} =>
167 if Value.<= (upper, Interval.lower i)
168 then Interval.lower i
169 else if Value.<= (Interval.upper i, lower)
170 then Interval.upper i
173 val {update, value} = Cache.peek (c, s)
176 val iSearch = Interval.intersect (i, iKnown)
177 val Interval.T {lower, upper} =
178 Interval.move iSearch
179 (* inv: lower <= v <= upper *)
181 if Value.equals (lower, v) then v
189 (s, Interval.T {lower = lower,
192 Value.unmove (loop (State.succ s, upper))
193 val Interval.T {lower, upper} = iSearch
197 if Value.equals (v, upper)
198 then Interval.above upper
199 else if Value.equals (v, lower)
200 then Interval.below lower
201 else Interval.point v)
202 in (*Misc.assert (fn () =>
205 alphaBetaNoCache (s, Value.smallest,
213 val Interval.T {lower, upper} = i
214 val Interval.T {lower = lower', upper = upper'} =
216 in if Value.<= (upper', lower)
218 else if Value.>= (lower', upper)
222 | NONE => search Interval.all