comparison src/elaborate.sml @ 904:6d9538ce94d8

Fix type class resolution infinite loop, discovered while meeting with Ezra
author Adam Chlipala <adamc@hcoop.net>
date Thu, 06 Aug 2009 15:23:04 -0400
parents d1d0b18afd3d
children b26823138bf8
comparison
equal deleted inserted replaced
903:63114a2e5075 904:6d9538ce94d8
3173 | _ => str) 3173 | _ => str)
3174 | _ => str 3174 | _ => str
3175 3175
3176 and elabDecl (dAll as (d, loc), (env, denv, gs)) = 3176 and elabDecl (dAll as (d, loc), (env, denv, gs)) =
3177 let 3177 let
3178 (*val () = preface ("elabDecl", SourcePrint.p_decl (d, loc))*) 3178 (*val () = preface ("elabDecl", SourcePrint.p_decl dAll)*)
3179 (*val befor = Time.now ()*) 3179 (*val befor = Time.now ()*)
3180 3180
3181 val r = 3181 val r =
3182 case d of 3182 case d of
3183 L.DCon (x, ko, c) => 3183 L.DCon (x, ko, c) =>
3408 L'.SgnFun _ => 3408 L'.SgnFun _ =>
3409 (case #1 str' of 3409 (case #1 str' of
3410 L'.StrFun _ => () 3410 L'.StrFun _ => ()
3411 | _ => strError env (FunctorRebind loc)) 3411 | _ => strError env (FunctorRebind loc))
3412 | _ => (); 3412 | _ => ();
3413
3414 ([(L'.DStr (x, n, sgn', str'), loc)], (env', denv', gs' @ gs)) 3413 ([(L'.DStr (x, n, sgn', str'), loc)], (env', denv', gs' @ gs))
3415 end 3414 end
3416 3415
3417 | L.DFfiStr (x, sgn) => 3416 | L.DFfiStr (x, sgn) =>
3418 let 3417 let
3618 ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs)) 3617 ([(L'.DStyle (!basis_r, x, n), loc)], (env, denv, gs))
3619 end 3618 end
3620 3619
3621 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*) 3620 (*val tcs = List.filter (fn TypeClass _ => true | _ => false) (#3 (#2 r))*)
3622 in 3621 in
3623 (*prefaces "elabDecl" [("e", SourcePrint.p_decl dAll), 3622 (*prefaces "/elabDecl" [("d", SourcePrint.p_decl dAll)];*)
3624 ("t", PD.string (LargeReal.toString (Time.toReal
3625 (Time.- (Time.now (), befor)))))];*)
3626
3627 r 3623 r
3628 end 3624 end
3629 3625
3630 and elabStr (env, denv) (str, loc) = 3626 and elabStr (env, denv) (str, loc) =
3631 case str of 3627 case str of