Contents

Transforming IF to guards

This is some general code on guarding things. I'm hoping to make it work out nicely.

First, the basics that must be expected of the expressions to be used in the guards. 

<guard.sig>= [D->]
signature GUARD_EXP = sig
  type exp
  val true'   : exp
  val false'  : exp
  val isTrue  : exp -> bool
  val isFalse : exp -> bool
  val conjoin : exp * exp -> exp   (* short-circuit, so order matters *)
  val negate  : exp -> exp         (* must be its own inverse *)
end
Defines conjoin, exp, false', GUARD_EXP, isFalse, isTrue, negate, true' (links are to index).

Now, as many useful operations as I can think of. 

<guard.sig>+= [<-D]
signature GUARD_LIKE = sig
  structure Exp : GUARD_EXP
  type 'a with_simple_guards = {guard : Exp.exp, value : 'a} list 
  type 'a with_guards (* = {guard : Exp.exp, value : 'a} list *)

  val single : 'a -> 'a with_guards
  val map : ('a -> 'b) -> 'a with_guards -> 'b with_guards
  val dropFalse : 'a with_guards -> 'a with_guards
  val guard : Exp.exp * 'a with_guards -> 'a with_guards
  val metaGuard : Exp.exp with_guards * 'a with_guards -> 'a with_guards
  val crossProduct : 'a with_guards list -> 'a list with_guards 

  (* these automatically drop false things *)
  val crossPair : 'a with_guards * 'b with_guards -> ('a * 'b) with_guards
  val flatten : 'a with_guards with_guards -> 'a with_guards
  val ifMap : Exp.exp with_guards * 'a with_guards * 'a with_guards -> 'a with_guards
end
signature GUARD = sig
  include GUARD_LIKE 
  sharing type with_guards = with_simple_guards
end
Defines crossPair, crossProduct, dropFalse, Exp, flatten, GUARD, guard, GUARD_LIKE, ifMap, map, metaGuard, single, with_guards, with_simple_guards (links are to index).

<guard.sml>=
functor GuardFun(Exp : GUARD_EXP) : GUARD = struct
  structure Exp = Exp
  type 'a with_simple_guards = {guard : Exp.exp, value : 'a} list 
  type 'a with_guards = {guard : Exp.exp, value : 'a} list
  <functions>
end
Defines Exp, GuardFun, with_guards, with_simple_guards (links are to index).

<functions>= (<-U) [D->]
fun single x = [{guard = Exp.true', value=x}]
fun map f l = List.map (fn {guard=g, value=x} => {guard=g, value=f x}) l
fun notFalse {guard=g, value} = not (Exp.isFalse g)
fun dropFalse l = List.filter notFalse l
fun guard (g, l) = 
  List.map (fn {guard=g', value=x} => {guard=Exp.conjoin(g, g'), value=x}) l
Defines dropFalse, guard, map, notFalse, single (links are to index).

<functions>+= (<-U) [<-D->]
fun flatten l =
  let fun flat ({guard=g, value=l}, tail) =
            let fun crush ({guard=g', value=x}, tail) =
                      let val newGuard = Exp.conjoin(g, g')
                      in  if Exp.isFalse newGuard then tail
                          else {guard=newGuard, value=x} :: tail
                      end
            in  foldr crush tail l
            end
  in  foldr flat [] l
  end
Defines flatten (links are to index).

<functions>+= (<-U) [<-D->]
fun cons ({guard=g, value=x}, {guard=g', value=tail}) = 
                         {guard=Exp.conjoin(g, g'), value=x :: tail}
fun crossProduct l = foldr (Util'.crossProduct cons) (single []) l
Defines cons, crossProduct (links are to index).

<functions>+= (<-U) [<-D->]
fun metaGuard (cond, value) = 
  let fun guard {guard=g1, value=g2} = Exp.conjoin(g1, g2)
      fun guards' {guard=g1, value=g2} = Exp.conjoin(g1, Exp.negate g2)
      fun --> (g, {guard=g', value=x}) = {guard=Exp.conjoin(g, g'), value=x}
  in  Util'.crossProduct --> (List.map guard cond, value)
  end
Defines metaGuard (links are to index).

<functions>+= (<-U) [<-D->]
fun crossPair (x's, y's) = 
  let fun cons ({guard=g, value=x}, tail) = 
        let fun pair ({guard=g', value=y}, tail) =
              let val g = Exp.conjoin(g, g')
              in  if Exp.isFalse g then tail else {guard=g, value=(x, y)} :: tail
              end
        in  foldr pair tail y's
        end
  in  foldr cons [] x's       
  end
Defines crossPair (links are to index).

<functions>+= (<-U) [<-D]
fun ifMap (p, t, f) =
  let val p' = map Exp.negate p
      val t = metaGuard(p,  t)
      val f = metaGuard(p', f)
  in  dropFalse t @ dropFalse f
  end
Defines ifMap (links are to index).