[MLton-commit] r5299

[Vesa Karvonen]

Renamed C to `.  Added combinators for ad hoc command line queries.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/misc-util/unstable/query.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/query.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/query.sml	2007-02-22 21:37:22 UTC (rev 5298)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/query.sml	2007-02-23 00:13:10 UTC (rev 5299)
@@ -19,9 +19,12 @@
    val get : 'a t -> 'a Option.t
    val mk : ('k -> 'v Option.t) -> 'k -> 'v t
    val E : String.t -> String.t t
-   val C : 'a -> 'a t
+   val ` : 'a -> 'a t
    val ^` : String.t t BinOp.t
    val @` : 'a t * ('a -> 'b Option.t) -> 'b t
+   val O : String.t -> Unit.t t
+   val L : String.t -> String.t t
+   val S : String.t -> String.t t
 end = struct
    type 'v t = 'v Option.t Thunk.t
    fun return x = const (SOME x)
@@ -30,7 +33,19 @@
    fun get q = q ()
    fun mk f k () = f k
    val E = mk OS.Process.getEnv
-   val C = return
-   fun lM ^` rM = lM >>= (fn l => rM >>= (fn r => C (l ^ r)))
+   val ` = return
+   fun lM ^` rM = lM >>= (fn l => rM >>= (fn r => ` (l ^ r)))
+   local
+      fun is s x = s = x
+      fun isE s = String.isPrefix (s^"=")
+      fun two f s = fn a::x::_ => SOME (f (s, a, x)) | _ => NONE
+      fun one f s = fn [] => NONE | x::_ => SOME (f (s, x))
+      val drop = flip List.dropWhile (CommandLine.arguments ())
+      fun arg p r e = mk (fn s => r e s o drop |< not o p s)
+   in
+      val L = arg isE one (fn (s, a) => String.extract (a, 1+size s, NONE))
+      val S = arg is two #3
+      val O = arg is one (const ())
+   end
    fun aM @` from = aM >>= const o from
 end