X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/cf879b4f037242eb535207f0ff3400fe89ab61b1..c219fe5500b4294ba8dc0bce57b5c7d60b39065e:/src/env.sml diff --git a/src/env.sml b/src/env.sml index f87278f..ef710c1 100644 --- a/src/env.sml +++ b/src/env.sml @@ -149,6 +149,10 @@ fun three func (name1, arg1, name2, arg2, name3, arg3) f (_, [e1, e2, e3]) = SM.empty)) | three func _ _ (_, es) = badArgs (func, es) +fun noneV func f (evs, []) = (f evs; + SM.empty) + | noneV func _ (_, es) = badArgs (func, es) + fun oneV func (name, arg) f (evs, [e]) = (case arg e of NONE => badArg (func, name, e) @@ -170,7 +174,9 @@ fun env arg (evs, name) = NONE => raise Fail ("Unavailable environment variable " ^ name) | SOME e => case arg e of - NONE => raise Fail ("Bad format for environment variable " ^ name) + NONE => (Print.preface ("Unexpected value for " ^ name ^ ":", + Print.p_exp e); + raise Fail ("Bad format for environment variable " ^ name)) | SOME v => v fun type_one func arg f = @@ -191,6 +197,7 @@ fun actionV_two name args f = registerAction (name, twoV name args f) fun container_none name (f, g) = registerContainer (name, none name f, g) fun container_one name args (f, g) = registerContainer (name, one name args f, g) +fun containerV_none name (f, g) = registerContainer (name, noneV name f, g) fun containerV_one name args (f, g) = registerContainer (name, oneV name args f, g) type env = SS.set * (typ * exp option) SM.map * SS.set