diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/elaborate.sig | 6 | ||||
-rw-r--r-- | src/elaborate.sml | 14 | ||||
-rw-r--r-- | src/main.mlton.sml | 3 |
3 files changed, 16 insertions, 7 deletions
diff --git a/src/elaborate.sig b/src/elaborate.sig index 6d1583a4..cc83b213 100644 --- a/src/elaborate.sig +++ b/src/elaborate.sig @@ -1,4 +1,4 @@ -(* Copyright (c) 2008, Adam Chlipala +(* Copyright (c) 2008, 2012, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -36,4 +36,8 @@ signature ELABORATE = sig (* After elaboration (successful or failed), should I output a mapping from * all identifiers to their kinds/types? *) + val unifyMore : bool ref + (* Run all phases of type inference, even if an error is detected by an + * early phase. *) + end diff --git a/src/elaborate.sml b/src/elaborate.sml index 1923390a..71f5196f 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -39,6 +39,7 @@ open ElabErr val dumpTypes = ref false + val unifyMore = ref false structure IS = IntBinarySet structure IM = IntBinaryMap @@ -4519,10 +4520,11 @@ fun elabFile basis topStr topSgn env file = end val checkConstraintErrors = ref (fn () => ()) + fun stopHere () = not (!unifyMore) andalso ErrorMsg.anyErrors () in oneSummaryRound (); - if ErrorMsg.anyErrors () then + if stopHere () then () else let @@ -4625,7 +4627,7 @@ fun elabFile basis topStr topSgn env file = mayDelay := false; - if ErrorMsg.anyErrors () then + if stopHere () then () else (app (fn (loc, env, k, s1, s2) => @@ -4641,7 +4643,7 @@ fun elabFile basis topStr topSgn env file = (!delayedUnifs); delayedUnifs := []); - if ErrorMsg.anyErrors () then + if stopHere () then () else if List.exists kunifsInDecl file then @@ -4651,7 +4653,7 @@ fun elabFile basis topStr topSgn env file = else (); - if ErrorMsg.anyErrors () then + if stopHere () then () else if List.exists cunifsInDecl file then @@ -4661,7 +4663,7 @@ fun elabFile basis topStr topSgn env file = else (); - if ErrorMsg.anyErrors () then + if stopHere () then () else app (fn all as (env, _, _, loc) => @@ -4670,7 +4672,7 @@ fun elabFile basis topStr topSgn env file = | SOME p => expError env (Inexhaustive (loc, p))) (!delayedExhaustives); - if ErrorMsg.anyErrors () then + if stopHere () then () else !checkConstraintErrors (); diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 57927258..00cb40b0 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -85,6 +85,9 @@ fun doArgs args = | "-dumpTypes" :: rest => (Elaborate.dumpTypes := true; doArgs rest) + | "-unifyMore" :: rest => + (Elaborate.unifyMore := true; + doArgs rest) | "-dumpSource" :: rest => (Compiler.dumpSource := true; doArgs rest) |