cs510 FSC Staged Computation   Assignment #6          Winter 2005
assigned Tuesday Feb. 8, 2005   due in class Tuesday Feb. 15, 2005

A) Recall the region datatype from class.

datatype Region
  = Univ
  | Empty
  | Circle of real
  | Rect of real * real
  | Union of Region*Region
  | Inter of Region*Region
  | Trans of ((real*real)*Region);


B) We defined a staged version of the meaning function.

fun plus x y = x+y;
fun minus x y = x-y;
fun neg x = 0.0 - x;
fun leq x y = x <= y;
fun square x = x*x;
fun between (a:real) b c = (leq a b) andalso (leq b c);

fun mean2 Empty (x,y) = <false>
  | mean2 Univ (x,y) = <true>
  | mean2 (Circle r) (x,y) =
          <leq (plus (square ~x) (square ~y)) (square ~(lift r))>
  | mean2 (Rect(w,h)) (x,y) =
          <(between (neg w) (plus ~x ~x) ~(lift w)) andalso
           (between (neg h) (plus ~y ~y) ~(lift h))>
  | mean2 (Trans((a,b),r)) (x,y) =
          mean2 r (<minus ~x ~(lift a)>,<minus ~y ~(lift b)>)
  | mean2 (Inter(a,b)) pt = <~(mean2 a pt) andalso ~(mean2 b pt)>
  | mean2 (Union(a,b)) pt = <~(mean2 a pt) orelse ~(mean2 b pt)>;

C) Notice that running this still generates duplicate sub-expressions.

val it =
<(fn (b,a) =>
     %disj
      (%leq
        (%plus (%square (%minus b (~2.0))) (%square (%minus a (0.0))))
        (%square (1.0)))
      (%disj
        (%leq
          (%plus
            (%square (%minus (%minus b (~2.0)) (2.0)))
            (%square (%minus (%minus a (0.0)) (0.0))))
          (%square (1.0)))
        (%disj
          (%leq
            (%plus
              (%square (%minus (%minus (%minus b (~2.0)) (2.0)) (2.0)))
              (%square (%minus (%minus (%minus a (0.0)) (0.0)) (0.0))))
            (%square (1.0)))
          false)))>
 : <(real * real) -> bool>

D) The memoizing Monad can be used to fix this

datatype ('a,'s,'c) mm = MM of ('s -> ('s -> 'a -> 'c) -> 'c);
fun unMM (MM f) = f;

fun runMM (MM f) = f [] (fn s => fn x => x);

fun mmReturn a = MM (fn s => fn k => k s a);
fun mmBind (MM a) f = MM(fn s => fn k => a s (fn s' => fn b => unMM (f b) s' k));
val mm = Mon(mmReturn,mmBind);

E)  by introducing a common subexpression operation.

The table 's will be a list of pairs. Each item in the pair will be
<real>, so 's = (<real>,<real>) list. The first part of the pair is
a complex expression, and the second is the name of a variable that
has been let-bound to the complex expression. E.g. [(<x +
4>,<x34>),(<x - 12>,<x35>)] The key operation looks up an
expression. If its there it returns the varaible, otherwise it
makes up a new variable stores it, and then returns the new
variable.


fun findCode x =
  let fun h s k = k s (find s)
      and find [] = NONE
        | find ((a,b)::ys) = if expEq x a then SOME b else find ys
  in MM h end;

fun memo2 x =
  let fun h s k = <let val z = ~x in ~(k (ext s (x,<z>)) <z>) end>
  in MM h end;

fun common exp =
 Do mm { a <- findCode exp
       ; case a of
           SOME z => Return mm z
         | NONE => memo2 exp  };

1) Rewrite "mean2" so that it is monadic

mean2 : Region ->
       (<real> * <real>) ->
       (<bool>,(<real> * <real>) list,<'a >) mm

For every code expression you generate that might get duplicated
use the common operation.

E.g.

fun f (Plus x y) =
  Do mm { a <- f x
        ; b <- f y
        ; common <~a + ~b>
        }

Be sure and test your code on a number of interesting examples.