[added option to bypass termination check for associated type synonyms (flag `--allow-diverging-tysyns')
mail@stefanwehr.de**20050526085730] {
addfile ./Configuration.hs
hunk ./Configuration.hs 1
+module Configuration where
+
+data TerminationCondition = DecreasingConstructorCount
+                          | AllowDiverge
+                            deriving (Eq,Show)
+
+data Configuration = Configuration 
+    { typeSynonymTermination  :: TerminationCondition }
+    deriving (Eq,Show)
+
+defaultConfiguration = Configuration
+    { typeSynonymTermination = DecreasingConstructorCount }
+
+
hunk ./Main.hs 37
+import Configuration
hunk ./Main.hs 66
-            do info "\n  ==> WELL-FORMEDNESS 1 <==\n"
+            do case terminationCondition flags of
+                  Nothing -> return ()
+                  Just t ->  modifyConfiguration 
+                               (\c -> c { typeSynonymTermination = t })
+
+               info "\n  ==> WELL-FORMEDNESS 1 <==\n"
hunk ./Main.hs 177
+terminationCondition :: [Flag] -> Maybe TerminationCondition
+terminationCondition [] = Nothing
+terminationCondition (TerminationCondition t:_) = Just t
+terminationCondition (_:rest) = terminationCondition rest
+
hunk ./Main.hs 194
+    | TerminationCondition TerminationCondition
hunk ./Main.hs 237
-            "do not print source file locations in error messages" ]
+            "do not print source file locations in error messages" 
+    , Option []    ["allow-diverging-tysyns"]
+          (NoArg (TerminationCondition AllowDiverge))
+          "do not check if the rewrite system for type synonyms is terminating"
+    ]
hunk ./Symtab.hs 25
-  Symtab, buildSymtab, 
+  Symtab, buildSymtab,
hunk ./Symtab.hs 29
+  getConfiguration, setConfiguration, modifyConfiguration,
+
hunk ./Symtab.hs 46
+
+import qualified UniqIdents
hunk ./Symtab.hs 53
-import qualified UniqIdents
-                   
+import Configuration
+
hunk ./Symtab.hs 61
-      globalEqualities  :: [EqualityDefinition]  -- assoc type definitions
+      globalEqualities  :: [EqualityDefinition],  -- assoc type definitions
+      configuration     :: Configuration
hunk ./Symtab.hs 70
-                       globalEqualities = [] }
+                       globalEqualities = [],
+                       configuration = defaultConfiguration }
hunk ./Symtab.hs 85
+
+modifyConfiguration :: (Configuration -> Configuration) -> ST ()
+modifyConfiguration f = 
+    modify (\s -> s { configuration = f (configuration s) })
+
+setConfiguration :: Configuration -> ST ()
+setConfiguration conf = modify (\s -> s { configuration = conf })
+
+getConfiguration :: ST Configuration
+getConfiguration = gets configuration
hunk ./WellFormedness.hs 35
+import Configuration
hunk ./WellFormedness.hs 187
-               checkDecreasingAssocTypeDefinition 
-                 (AssocTypeBind aid (TyVar x) xs t)
+                do conf <- getConfiguration
+                   if typeSynonymTermination conf == DecreasingConstructorCount
+                      then checkDecreasingAssocTypeDefinition 
+                               (AssocTypeBind aid (TyVar x) xs t)
+                      else return ()
+                 
hunk ./WellFormedness.hs 354
-       checkDecreasingAssocTypeDefinition atb
+       conf <- getConfiguration
+       if typeSynonymTermination conf == DecreasingConstructorCount
+          then checkDecreasingAssocTypeDefinition atb
+          else return ()
addfile ./tests/fixed-assoc-types/should_fail/allow-diverge/000.err
hunk ./tests/fixed-assoc-types/should_fail/allow-diverge/000.err 1
+illegal associated type application: `S a[1]'. Cannot deduce `C a[1]' from program context and {}
hunk ./tests/fixed-assoc-types/should_fail/allow-diverge/Flag 1
---allow-diverging-tysyns
+--allow-diverging-tysyns --no-location expect-fail
addfile ./tests/fixed-assoc-types/should_pass/allow-diverge/000.out
hunk ./tests/fixed-assoc-types/should_pass/allow-diverge/000.out 1
+foo :: T Bool
hunk ./tests/fixed-assoc-types/should_pass/allow-diverge/Flag 1
---allow-diverging-tysyns
+--dump-infer --allow-diverging-tysyns
}