]> Joshua Wise's Git repositories - snipe.git/blame_incremental - util/flag.sml
Rename output binary from l5c to snipe
[snipe.git] / util / flag.sml
... / ...
CommitLineData
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
7signature FLAG =
8sig
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 *)
29end
30
31structure Flag :> FLAG =
32struct
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))
51end
This page took 0.027724 seconds and 5 git commands to generate.