Mercurial > urweb
diff src/elab_env.sml @ 403:8084fa9216de
New implicit argument handling
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 21 Oct 2008 16:41:11 -0400 |
parents | 389399d65331 |
children | cb5897276abf |
line wrap: on
line diff
--- a/src/elab_env.sml Tue Oct 21 15:11:42 2008 -0400 +++ b/src/elab_env.sml Tue Oct 21 16:41:11 2008 -0400 @@ -358,7 +358,7 @@ sgn = #sgn env, renameStr = #renameStr env, - str = #str env} + str = #str env} fun class_name_in (c, _) = case c of @@ -367,6 +367,14 @@ | CUnif (_, _, _, ref (SOME c)) => class_name_in c | _ => NONE +fun isClass (env : env) c = + let + fun find NONE = false + | find (SOME c) = Option.isSome (CM.find (#classes env, c)) + in + find (class_name_in c) + end + fun class_key_in (c, _) = case c of CRel n => SOME (CkRel n) @@ -405,14 +413,16 @@ val classes = case class_pair_in t of NONE => classes | SOME (f, x) => - let - val class = Option.getOpt (CM.find (classes, f), empty_class) - val class = { - ground = KM.insert (#ground class, x, (ERel 0, #2 t)) - } - in - CM.insert (classes, f, class) - end + case CM.find (classes, f) of + NONE => classes + | SOME class => + let + val class = { + ground = KM.insert (#ground class, x, (ERel 0, #2 t)) + } + in + CM.insert (classes, f, class) + end in {renameC = #renameC env, relC = #relC env, @@ -444,14 +454,16 @@ val classes = case class_pair_in t of NONE => classes | SOME (f, x) => - let - val class = Option.getOpt (CM.find (classes, f), empty_class) - val class = { - ground = KM.insert (#ground class, x, (ENamed n, #2 t)) - } - in - CM.insert (classes, f, class) - end + case CM.find (classes, f) of + NONE => classes + | SOME class => + let + val class = { + ground = KM.insert (#ground class, x, (ENamed n, #2 t)) + } + in + CM.insert (classes, f, class) + end in {renameC = #renameC env, relC = #relC env, @@ -740,14 +752,21 @@ | SOME ck => let val cn = ClProj (m1, ms, fx) - val class = Option.getOpt (CM.find (classes, cn), empty_class) - val class = { - ground = KM.insert (#ground class, ck, - (EModProj (m1, ms, x), #2 sgn)) - } + val classes = + case CM.find (classes, cn) of + NONE => classes + | SOME class => + let + val class = { + ground = KM.insert (#ground class, ck, + (EModProj (m1, ms, x), #2 sgn)) + } + in + CM.insert (classes, cn, class) + end in - (CM.insert (classes, cn, class), + (classes, newClasses, fmap, env)