From b54c31e0cdd832859c14b0c307df3cc39baa2511 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 22 Mar 2019 03:43:17 -0400 Subject: Let 0 and 1 translate to False and True when appropriate. --- monkeypatch.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) 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 -- cgit v1.2.3