util/flag.sml

   1 (* L1 Compiler
   2  * Simple structure for cleanly handling input parameters
   3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
   4  * Annotations: Alex Vaynberg <alv@andrew.cmu.edu>
   5  *)
   6
   7 signature FLAG =
   8 sig
   9   type flag
  10
  11   val flag : string -> flag     (* create a new flag that is not set *)
  12   val not : flag -> flag        (* reverses the meaning of flag being set *)
  13
  14   val set : flag -> unit        (* set a flag *)
  15   val unset : flag -> unit      (* unset a flag *)
  16   val isset : flag -> bool      (* check if the flag is set *)
  17
  18   val guard : flag -> ('a -> unit) -> 'a -> unit
  19                                 (* return a function that runs only if flag is set *)
  20   val guards : flag list -> ('a -> unit) -> 'a -> unit
  21                                 (* return a function that runs only if all flags are set *)
  22   val someguards : flag list -> ('a -> unit) -> 'a -> unit
  23                                 (* return a func that runs if one of flags is set *)
  24
  25   (* get a function that runs the first one if flag is set, or second one if it is not *)
  26   val branch : flag -> ('a -> 'b) * ('a -> 'b) -> 'a -> 'b
  27
  28   val show : flag -> string (* returns string that contains the setting of the flag *)
  29 end
  30
  31 structure Flag :> FLAG =
  32 struct
  33   datatype flag = FLAG of {name : string, value : bool ref, post : bool -> bool}
  34
  35   fun flag name = FLAG {name = name, value = ref false, post = fn b => b}
  36
  37   fun set (FLAG f) = #value f := true
  38   fun unset (FLAG f) = #value f := false
  39   fun not (FLAG {name, value, post}) =
  40         FLAG {name = name, value = value, post = fn b => Bool.not (post b)}
  41
  42   fun isset (FLAG f) = (#post f) (! (#value f))
  43
  44   fun guard fl f x = if isset fl then f x else ()
  45   fun guards fls f x = if List.all isset fls then f x else ()
  46   fun someguards fls f x = if List.exists isset fls then f x else ()
  47
  48   fun branch fl (f, g) = if isset fl then f else g
  49
  50   fun show (FLAG f) = "flag " ^ #name f ^ " = " ^ Bool.toString (! (#value f))
  51 end