[Implement check of bidirectionalizability.
Kazutaka Matsuda <kztk@kb.ecei.tohoku.ac.jp>**20100913135503
 Ignore-this: 4b31d33b211333ad09a283f935ff5b28
] hunk ./SemSyn.hs 175
+checkBidirectionalizability :: AST -> AST 
+checkBidirectionalizability ast = 
+    case (checkTreeless $ eraseType ast, checkAffine $ eraseType ast)  of 
+      (Nothing, Nothing) -> ast
+      (Just (e,d),Nothing)       -> error $ showTreelessError (e,d) 
+      (Nothing, Just (vs,d'))    -> error $ showAffineError   (vs,d')
+      (Just (e,d), Just (vs,d')) -> error $ showTreelessError (e,d) ++ "\n" ++ showAffineError (vs,d') 
+    where
+      showTreelessError (e,d)
+          = show $ (text "Error: program is not treeless due to expression" $$
+                         nest 4 (ppr e) $$
+                         text "in declaration" $$ 
+                         nest 4 (ppr d))
+      showAffineError (vs,d)
+          = show $ (text "Error: program is not affine due to variables" $$
+                         nest 4 (ppr vs) $$
+                         text "in declaration" $$ 
+                         nest 4 (ppr d))
+      
+                                                         
+                                                        
+
+-- msum []     = mzero
+-- msum (m:ms) = mplus m (msum ms)
hunk ./SemSyn.hs 200
-checkTreeless :: AST -> Bool
-checkTreeless (AST decls) = all checkTreelessD decls
+-- Nothing    : treeless
+-- Just (e,d) : not treeless because of d 
+checkTreeless :: AST -> Maybe (Exp, Decl)
+checkTreeless (AST decls) = msum $ map checkTreelessD decls
hunk ./SemSyn.hs 205
-      checkTreelessD (Decl _ _ _ e) = checkTreelessE e
-      checkTreelessE (EVar _ _ _)    = True
-      checkTreelessE (ECon _ _ _ es) = all checkTreelessE es
-      checkTreelessE (EFun _ _ _ es) = all isVariable es
-      isVariable (EVar _ _ _) = True
-      isVariable _            = False
+      checkTreelessD (d@(Decl _ _ _ e))  = checkTreelessE d e 
+      checkTreelessE d (EVar _ _ _)      = Nothing 
+      checkTreelessE d (ECon _ _ _ es)   = msum $ map (checkTreelessE d) es
+      checkTreelessE d (e@(EFun _ _ _ es)) | all isVariable es = Nothing 
+                                           | otherwise         = Just (e,d)       
+      isVariable (EVar _ _ _) = True 
+      isVariable e            = False
hunk ./SemSyn.hs 213
-checkAffine :: AST -> Bool 
-checkAffine (AST decls) = all checkAffineD decls
+-- Nothing    : treeless
+-- Just (e,d) : not treeless because of d 
+checkAffine :: AST -> Maybe ([Name],Decl)
+checkAffine (AST decls) = msum $ map checkAffineD decls
hunk ./SemSyn.hs 218
-      checkAffineD (Decl _ _ _ e) = checkAffineE e 
-      checkAffineE e = (varsE e == snub (varsE e))
+      checkAffineD (d@(Decl _ _ _ e)) = checkAffineE d e 
+      checkAffineE d e | (sort (varsE e) == snub (varsE e)) = Nothing
+                       | otherwise                          = Just (sort (varsE e) \\ snub (varsE e),d)