CVS: sml/src/smlnj-lib/Util getopt-sig.sml,1.3,1.4 getopt.sml,1.3,1.4
John Reppy <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml/src/smlnj-lib/Util
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4070/Util
Modified Files:
getopt-sig.sml getopt.sml
Log Message:
Fixed bug in GetOpt.
Index: getopt-sig.sml
===================================================================
RCS file: /cvsroot/smlnj/sml/src/smlnj-lib/Util/getopt-sig.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** getopt-sig.sml 18 Jul 2000 17:44:36 -0000 1.3
--- getopt-sig.sml 21 Mar 2005 19:45:03 -0000 1.4
***************
*** 49,54 ****
(* Description of an argument option:
* NoArg: no argument required
! * ReqArg: option requires an argument
! * OptArg: optional argument
*)
--- 49,54 ----
(* Description of an argument option:
* NoArg: no argument required
! * ReqArg: option requires an argument; the string is the argument name
! * OptArg: optional argument; the string is the argument name
*)
***************
*** 66,70 ****
} -> string
(* takes a header string and a list of option descriptions and
! * returns a string explaining the usage information
*)
--- 66,71 ----
} -> string
(* takes a header string and a list of option descriptions and
! * returns a string explaining the usage information. A newline will
! * be added following the header, so it should not be newline terminated.
*)
Index: getopt.sml
===================================================================
RCS file: /cvsroot/smlnj/sml/src/smlnj-lib/Util/getopt.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** getopt.sml 4 May 2001 16:37:36 -0000 1.3
--- getopt.sml 21 Mar 2005 19:45:03 -0000 1.4
***************
*** 30,35 ****
datatype 'a opt_kind
= Opt of 'a
! | NonOpt of string
! | EndOfOpts
structure SS = Substring
--- 30,34 ----
datatype 'a opt_kind
= Opt of 'a
! | NonOpt
structure SS = Substring
***************
*** 104,125 ****
* this is messy because you cannot pattern-match on substrings
*)
! fun longOpt (subs, rest, optDescr : 'a opt_descr list) = let
! val (opt,arg) = breakeq subs
val opt' = SS.string opt
val options = List.filter
(fn {long,...} => List.exists (S.isPrefix opt') long)
! optDescr
val optStr = "--"^opt'
fun long (_::(_::_), _, rest') = (
! errAmbig optStr; (NonOpt optStr, rest'))
| long ([NoArg a], x, rest') =
if (SS.isEmpty x)
then (Opt(a()),rest')
else if (SS.isPrefix "=" x)
! then (errNoArg optStr; (NonOpt optStr, rest'))
else raise Fail "long: impossible"
| long ([ReqArg(f,d)], x, []) =
if (SS.isEmpty x)
! then (errReq(d, optStr); (NonOpt optStr, []))
else if (SS.isPrefix "=" x)
then (Opt(f (SS.string (SS.triml 1 x))), [])
--- 103,124 ----
* this is messy because you cannot pattern-match on substrings
*)
! fun longOpt (subs, rest) = let
! val (opt, arg) = breakeq subs
val opt' = SS.string opt
val options = List.filter
(fn {long,...} => List.exists (S.isPrefix opt') long)
! options
val optStr = "--"^opt'
fun long (_::(_::_), _, rest') = (
! errAmbig optStr; (NonOpt, rest'))
| long ([NoArg a], x, rest') =
if (SS.isEmpty x)
then (Opt(a()),rest')
else if (SS.isPrefix "=" x)
! then (errNoArg optStr; (NonOpt, rest'))
else raise Fail "long: impossible"
| long ([ReqArg(f,d)], x, []) =
if (SS.isEmpty x)
! then (errReq(d, optStr); (NonOpt, []))
else if (SS.isPrefix "=" x)
then (Opt(f (SS.string (SS.triml 1 x))), [])
***************
*** 138,142 ****
else raise Fail "long: impossible"
| long ([], _, rest') = (
! errUnrec optStr; (NonOpt optStr, rest'))
in
long (map #desc options, arg, rest)
--- 137,141 ----
else raise Fail "long: impossible"
| long ([], _, rest') = (
! errUnrec optStr; (NonOpt, rest'))
in
long (map #desc options, arg, rest)
***************
*** 146,157 ****
* options.
*)
! fun shortOpt (x, subs, rest, optDescr : 'a opt_descr list) = let
val options =
! List.filter (fn {short,...} => Char.contains short x) optDescr
val ads = map #desc options
val optStr = "-"^(str x)
in
case (ads, rest)
! of (_::_::_, rest1) => (errAmbig optStr; (NonOpt optStr, rest1))
| ((NoArg a)::_, rest') =>
if (SS.isEmpty subs)
--- 145,156 ----
* options.
*)
! fun shortOpt (x, subs, rest) = let
val options =
! List.filter (fn {short,...} => Char.contains short x) options
val ads = map #desc options
val optStr = "-"^(str x)
in
case (ads, rest)
! of (_::_::_, rest1) => (errAmbig optStr; (NonOpt, rest1))
| ((NoArg a)::_, rest') =>
if (SS.isEmpty subs)
***************
*** 160,164 ****
| ((ReqArg(f,d))::_, []) =>
if (SS.isEmpty subs)
! then (errReq(d, optStr); (NonOpt optStr, []))
else (Opt(f (SS.string subs)), [])
| ((ReqArg(f,_))::_, rest' as (r::rs)) =>
--- 159,163 ----
| ((ReqArg(f,d))::_, []) =>
if (SS.isEmpty subs)
! then (errReq(d, optStr); (NonOpt, []))
else (Opt(f (SS.string subs)), [])
| ((ReqArg(f,_))::_, rest' as (r::rs)) =>
***************
*** 170,211 ****
then (Opt(f NONE), rest')
else (Opt(f (SOME(SS.string subs))), rest')
! | ([], rest') =>
! if (SS.isEmpty subs)
! then (errUnrec optStr; (NonOpt optStr, rest'))
! else (
! errUnrec optStr;
! (NonOpt optStr, ("-" ^ SS.string subs)::rest'))
(* end case *)
end
! (* take a look at the next command line argument and decide what to
! * do with it
! *)
! fun getNext ([], _) = raise Fail "getNext: impossible"
! | getNext ("--" :: rest, _) = (EndOfOpts, rest)
! | getNext (x::rest, optDescr) = let
! val x' = SS.all x
in
! if (SS.isPrefix "--" x')
! then longOpt (SS.triml 2 x', rest, optDescr)
! else if (SS.isPrefix "-" x')
! then shortOpt (SS.sub(x',1), SS.triml 2 x', rest, optDescr)
! else (NonOpt x,rest)
end
- fun get [] = ([], [])
- | get args = let
- val (opt, rest) = getNext (args, options)
- val (os, xs) = get rest
- fun procNextOpt (Opt o', _) = (o'::os, xs)
- | procNextOpt (NonOpt x, RequireOrder) = ([],x::rest)
- | procNextOpt (NonOpt x, Permute) = (os,x::xs)
- | procNextOpt (NonOpt x, ReturnInOrder f) = ((f x)::os,xs)
- | procNextOpt (EndOfOpts, RequireOrder) = ([],rest)
- | procNextOpt (EndOfOpts, Permute) = ([],rest)
- | procNextOpt (EndOfOpts, ReturnInOrder f) = (map f rest,[])
- in
- procNextOpt(opt, argOrder)
- end
in
! get
end (* getOpt *)
--- 169,201 ----
then (Opt(f NONE), rest')
else (Opt(f (SOME(SS.string subs))), rest')
! | ([], rest') => (errUnrec optStr; (NonOpt, rest'))
(* end case *)
end
! fun get ([], opts, nonOpts) = (List.rev opts, List.rev nonOpts)
! | get ("--"::rest, opts, nonOpts) = let
! val nonOpts = List.revAppend(nonOpts, rest)
in
! case argOrder
! of ReturnInOrder f => (List.revAppend(opts, List.map f nonOpts), [])
! | _ => (List.rev opts, nonOpts)
! (* end case *)
! end
! | get (arg::rest, opts, nonOpts) = let
! val arg' = SS.full arg
! fun addOpt (Opt opt, rest) = get(rest, opt::opts, nonOpts)
! | addOpt (NonOpt, rest) = get(rest, opts, arg::nonOpts)
! in
! if (SS.isPrefix "--" arg')
! then addOpt(longOpt (SS.triml 2 arg', rest))
! else if (SS.isPrefix "-" arg')
! then addOpt(shortOpt (SS.sub(arg', 1), SS.triml 2 arg', rest))
! else (case argOrder
! of RequireOrder => (List.rev opts, List.revAppend(nonOpts, arg::rest))
! | Permute => get(rest, opts, arg::nonOpts)
! | ReturnInOrder f => get(rest, f arg :: opts, nonOpts)
! (* end case *))
end
in
! fn args => get(args, [], [])
end (* getOpt *)
-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click