
(* mutable collection of flags and string constants.
   see params-sig.sml.
*)

structure Params :> PARAMS =
struct

  exception BadOption of string

  val flags = (ref nil) 
              : (bool ref * bool * (string * string) option * 
                 string) list ref

  val params = (ref nil)
               : (string ref * string * (string * string) option * 
                  string) list ref

  fun I x = x

  fun get lr name =
    let
      fun f nil = NONE
        | f ((r, _, _, n)::t) = if name = n 
                               then SOME r
                             else f t 
    in
      f (!lr)
    end

  fun argget lr name =
    let
      fun f nil = NONE
        | f ((r, _, SOME(n, _), _)::t) = if name = n 
                                           then SOME r
                                         else f t 
        | f (_::t) = f t
    in
      f (!lr)
    end

  fun make lr default cmd name =
    case get lr name of
      NONE => 
        let 
          val h = ref default
        in
          lr := ((h,default,cmd,name) :: !lr);
          h
        end
    | SOME r => r


  val getflag = get flags
  val flag = make flags
    
  val getparam = get params
  val param = make params

  val table = StringUtil.table 75

  fun usage () =
    let fun f s ts l = rev (foldr (fn ((_, d, SOME (cl, doc), _), b) =>
                                   [cl, ts d, doc] :: b 
                                   | (_, b) => b) [s] l)
        fun bts d = (if d then "(true)" else "(false)")
    in
      (case !flags of
         nil => ""
       | l => "The following flags are supported (specify to toggle):\n" ^
              (table (f ["flag", "default", "description"] bts l))) ^
      (case !params of
         nil => ""
       | l => "\nThe following parameters are supported (specify,\n" ^
              "followed by a string, to change them):\n" ^
              (table (f ["param", "default", "description"] I l))) 
    end

  fun docommandline () = 
    let
      fun f nil l = rev l
        | f (h::t) l =
        let in
        case argget flags h of
          NONE =>
            (case argget params h of
               NONE => f t (h::l)
             | SOME sr => 
                 (case t of 
                    nil => raise BadOption 
                          (h ^ " must be followed by a value.\n")
                  | v::rest => 
                          let in
                            sr := v;
                            f rest l
                          end))
        | SOME br => let in
                       br := (not (!br));
                       f t l
                     end
        end
    in
      f (CommandLine.arguments()) nil
    end

end
