Handle typeCheck error in Main.hs
authorJoachim Breitner <mail@joachim-breitner.de>
Thu, 16 Sep 2010 14:36:29 +0000 (14:36 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Thu, 16 Sep 2010 14:36:29 +0000 (14:36 +0000)
Main.hs
SemSyn.hs

diff --git a/Main.hs b/Main.hs
index 1175649..d1156c1 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -229,7 +229,9 @@ main = do { args <- getArgs
                                        parseFile filename
                      ; case csterr of
                          Left err -> hPutStrLn stderr (show err)
-                         Right cprog -> 
+                         Right cprog ->  case typeInference cprog of
+                            Left err -> hPutStrLn stderr err
+                            Right typeChecked -> 
                              case execMode conf of 
 --                                Normal | (b18nMode conf == SyntacticB18n || b18nMode conf == NoB18n) -> 
 --                                    print $
@@ -241,7 +243,7 @@ main = do { args <- getArgs
 --                                    print $
 --                                          outputCode conf True  (cprog) (introNat $ shapify $ typeInference cprog)
                                Debug ->
-                                   putStrLn "Debug mode does nothing."
+                                       putStrLn "Debug mode does nothing."
 --                                    do { print $ ppr   $ cprog
 --                                       -- ; print $ pprAM $ constructAutomaton (typeInference cprog) initTAMap
 --                                       ; let (p1,p2,p3) = constructBwdFunction (typeInference cprog)
@@ -258,13 +260,13 @@ main = do { args <- getArgs
 --                                       ; putStrLn ""
 --                                       }
                                _ | isNormalMode conf ->
-                                     let transformed = typeInference cprog 
+                                     let transformed = typeChecked
                                      in checkAndDoBidirectionalize conf False cprog transformed
                                _ | isShapifyMode conf -> 
-                                     let transformed = shapify $ typeInference cprog 
+                                     let transformed = shapify $ typeChecked
                                      in checkAndDoBidirectionalize conf False cprog transformed
                                _ | isShapifyPlusMode conf || True -> 
-                                     let transformed = introNat $ shapify $ typeInference cprog
+                                     let transformed = introNat $ shapify $ typeChecked
                                      in checkAndDoBidirectionalize conf True cprog transformed 
                      }
           }
index df353c7..d13748f 100644 (file)
--- a/SemSyn.hs
+++ b/SemSyn.hs
@@ -106,7 +106,7 @@ outputCode conf_ isShapify orig ast =
              [ text "import Data.Bff" ] ++
              [ text "import BUtil" ] ++ 
              (map genBwdDefBff $ 
-                   let AST decls = typeInference orig 
+                   let Right (AST decls) = typeInference orig 
                    in map (\(Decl f t _ _:_) -> (f,t)) $ groupBy isSameFunc decls) ++
              [ ppr $ generateCodeDet orig ]             
          CombinedB18n -> vcat $ 
@@ -115,7 +115,7 @@ outputCode conf_ isShapify orig ast =
              ] ++ (
              if isShapify
              then map genBwdDef $
-                     let AST decls = typeInference orig
+                     let Right (AST decls) = typeInference orig
                      in map (\(Decl f t _ _:_) -> (f,t)) $ groupBy isSameFunc decls
              else []                                     
              ) ++
@@ -192,10 +192,14 @@ isShapifyPlusMode conf =
 
 renderCode :: Config -> AST -> Doc
 renderCode conf cprog
-    | isNormalMode conf =      outputCode conf False (cprog) (typeInference cprog)
-    | isShapifyMode conf =     outputCode conf False (cprog) (shapify $ typeInference cprog)
-    | isShapifyPlusMode conf = outputCode conf True  (cprog) (introNat $ shapify $ typeInference cprog)
-    | otherwise =              outputCode conf True  (cprog) (introNat $ shapify $ typeInference cprog)
+    | isNormalMode conf =      outputCode conf False (cprog) $
+                                    either error id $ typeInference cprog
+    | isShapifyMode conf =     outputCode conf False (cprog) $
+                                    shapify $ either error id $ typeInference cprog
+    | isShapifyPlusMode conf = outputCode conf True  (cprog) $
+                                    introNat $ shapify $ either error id $ typeInference cprog
+    | otherwise =              outputCode conf True  (cprog) $
+                                    introNat $ shapify $ either error id $ typeInference cprog
 
 
 checkBidirectionalizability :: AST -> Maybe String