Mercurial > urweb

comparison src/elaborate.sml @ 1744:6fcce0592178

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Send daemon output to calling process
author Adam Chlipala <adam@chlipala.net>
date Sat, 05 May 2012 12:45:35 -0400
parents fca4a6d05ac1
children 518e0b23c4ef
comparison
equal deleted inserted replaced
1743:1e940643a5f0 1744:6fcce0592178
39 open ElabErr 39 open ElabErr
40 40
41 val dumpTypes = ref false 41 val dumpTypes = ref false
42 val unifyMore = ref false 42 val unifyMore = ref false
43 val incremental = ref false 43 val incremental = ref false
44 val verbose = ref false
44 45
45 structure IS = IntBinarySet 46 structure IS = IntBinarySet
46 structure IM = IntBinaryMap 47 structure IM = IntBinaryMap
47 48
48 structure SK = struct 49 structure SK = struct
3929 3930
3930 | L.DStr (x, sgno, tmo, str) => 3931 | L.DStr (x, sgno, tmo, str) =>
3931 (case ModDb.lookup dAll of 3932 (case ModDb.lookup dAll of
3932 SOME d => 3933 SOME d =>
3933 let 3934 let
3935 val () = if !verbose then TextIO.print ("REUSE: " ^ x ^ "\n") else ()
3934 val env' = E.declBinds env d 3936 val env' = E.declBinds env d
3935 val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []} 3937 val denv' = dopenConstraints (loc, env', denv) {str = x, strs = []}
3936 in 3938 in
3937 ([d], (env', denv', gs)) 3939 ([d], (env', denv', gs))
3938 end 3940 end
3939 | NONE => 3941 | NONE =>
3940 let 3942 let
3943 val () = if !verbose then TextIO.print ("CHECK: " ^ x ^ "\n") else ()
3944
3941 val () = if x = "Basis" then 3945 val () = if x = "Basis" then
3942 raise Fail "Not allowed to redefine structure 'Basis'" 3946 raise Fail "Not allowed to redefine structure 'Basis'"
3943 else 3947 else
3944 () 3948 ()
3945 3949
4678 | TypeClass (env, c, r, loc) => 4682 | TypeClass (env, c, r, loc) =>
4679 let 4683 let
4680 val c = normClassKey env c 4684 val c = normClassKey env c
4681 in 4685 in
4682 case resolveClass env c of 4686 case resolveClass env c of
4683 SOME _ => raise Fail "Type class resolution succeeded unexpectedly" 4687 SOME _ => ()
4684 | NONE => expError env (Unresolvable (loc, c)) 4688 | NONE => expError env (Unresolvable (loc, c))
4685 end) 4689 end)
4686 gs) 4690 gs)
4687 end 4691 end
4688 in 4692 in