Let 0 and 1 translate to False and True when appropriate.

1 files changed, 15 insertions, 1 deletions

diff --git a/monkeypatch.hs b/monkeypatch.hs
index f12552e..95cf709 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -376,12 +376,21 @@ grokInitialization fe ts (Just (CDeclr (Just cv0) _ _ _ _),CInitList exps _) = d
         _ -> Nothing
 grokInitialization _ _ _ = Nothing
 
+hasBool :: HS.Type () -> Bool
+hasBool = (1 <=) . gcount (mkQ False (\t -> case t of { HS.Ident () "Bool" -> True; _ -> False }))
+
+promote :: Map String (HS.Type ()) -> HS.Exp () -> HS.Exp ()
+promote fe y@(Lit () (Int () n _)) | (n==0 || n==1) &&  hasBool (fe Map.! "") =
+    HS.Con () $ UnQual () $ HS.Ident () $ case n of
+        0 -> "False"
+        1 -> "True"
+promote _ y = y
 
 grokStatement :: FunctionEnvironment -> CCompoundBlockItem a -> Maybe (Computation (HS.Exp ()))
 grokStatement fe (CBlockStmt (CReturn (Just exp) _)) = do
     (xs,x) <- grokExpression fe exp
     let k = uniqIdentifier "go" (compFree x `Map.union` compIntro x)
-        x' = fmap (\y -> App () (hsvar "return") y) x
+        x' = fmap (\y -> App () (hsvar "return") $ promote (fnArgs fe) y) x
     return $ fmap (\y -> Lambda () [hspvar k] y) $ foldr applyComputation x' xs
 grokStatement fe (CBlockStmt (CExpr (Just (C.CCall (CVar (C.Ident "__assert_fail" _ _) _) xs _)) _)) = do
     x <- case xs of
@@ -527,20 +536,25 @@ getSymbolExtent sym bdy =
         stop  = maximumBy (comparing posRow) allposss
     in SymbolExtent start stop
 
+lastRowOf :: CNode a => a -> Int
 lastRowOf x = case getLastTokenPos $ nodeInfo x of
     (p,len) | isSourcePos p -> posRow p + len
     _                       -> maxBound
 
+firstRowOf :: CNode a => a -> Int
 firstRowOf x = case posOfNode $ nodeInfo x of
     p | isSourcePos p -> posRow p
     _                 -> minBound
 
+columnOf :: CNode a => a -> Int
 columnOf x = case posOfNode $ nodeInfo x of
     p | isSourcePos p -> posColumn p
     _                 -> minBound
 
+comesBefore :: CNode a => a -> StyledComment -> Bool
 comesBefore x c = lastRowOf x < commentRow c
 
+comesAfter :: CNode a => a -> StyledComment -> Bool
 comesAfter x c = firstRowOf x > commentRow c
 
 insertComment :: Data t => StyledComment -> t -> t