diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-14 17:58:21 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-14 17:58:21 -0400 |
commit | fc1e52a9cf8ae7c5b79118f4ebbe68385bfd9be6 (patch) | |
tree | 334b686a2059360eae0b3b5b4b3cf386d5388c7e /monkeypatch.hs | |
parent | 29cb139e8b4939353ca6334cc2540b8a8476b057 (diff) |
Restrict transpilation to functions.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 46 |
1 files changed, 32 insertions, 14 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index c09fcc7..121809a 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -149,6 +149,11 @@ grokExpression (CVar cv _) = Just Computation | |||
149 | , compIntro = Map.empty | 149 | , compIntro = Map.empty |
150 | , comp = hsvar (identToString cv) | 150 | , comp = hsvar (identToString cv) |
151 | } | 151 | } |
152 | grokExpression (CConst (CIntConst n _)) = Just Computation | ||
153 | { compFree = Map.empty | ||
154 | , compIntro = Map.empty | ||
155 | , comp = Lit () (Int () (getCInteger n) (show n)) | ||
156 | } | ||
152 | grokExpression (CBinary CNeqOp a b _) = do | 157 | grokExpression (CBinary CNeqOp a b _) = do |
153 | ca <- grokExpression a | 158 | ca <- grokExpression a |
154 | cb <- grokExpression b | 159 | cb <- grokExpression b |
@@ -204,7 +209,6 @@ grokStatement (CBlockStmt (CReturn (Just exp) _)) = do | |||
204 | x <- grokExpression exp | 209 | x <- grokExpression exp |
205 | let k = uniqIdentifier "go" (compFree x `Map.union` compIntro x) | 210 | let k = uniqIdentifier "go" (compFree x `Map.union` compIntro x) |
206 | return $ fmap (\y -> Lambda () [hspvar k] $ App () (hsvar "return") y) x | 211 | return $ fmap (\y -> Lambda () [hspvar k] $ App () (hsvar "return") y) x |
207 | |||
208 | grokStatement (CBlockStmt (CExpr (Just | 212 | grokStatement (CBlockStmt (CExpr (Just |
209 | (CAssign CAssignOp cvarnew | 213 | (CAssign CAssignOp cvarnew |
210 | (C.CCall cvarfun [] _) _)) _)) = do | 214 | (C.CCall cvarfun [] _) _)) _)) = do |
@@ -236,6 +240,11 @@ grokStatement (CBlockDecl (CDecl (t:_) (v:vs) _)) = do | |||
236 | } | 240 | } |
237 | grokStatement _ = Nothing | 241 | grokStatement _ = Nothing |
238 | 242 | ||
243 | isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True | ||
244 | isFunctionDecl (CFDefExt (CFunDef _ _ _ (CCompound [] _ _) _)) = True | ||
245 | isFunctionDecl _ = False | ||
246 | |||
247 | |||
239 | 248 | ||
240 | transpile :: C2HaskellOptions -> FilePath -> IncludeStack -> CTranslationUnit NodeInfo -> IO () | 249 | transpile :: C2HaskellOptions -> FilePath -> IncludeStack -> CTranslationUnit NodeInfo -> IO () |
241 | transpile o fname incs (CTranslUnit edecls _) = do | 250 | transpile o fname incs (CTranslUnit edecls _) = do |
@@ -256,19 +265,28 @@ transpile o fname incs (CTranslUnit edecls _) = do | |||
256 | i <- m | 265 | i <- m |
257 | maybe [] (return . identToString) i | 266 | maybe [] (return . identToString) i |
258 | -- mapM_ (putStrLn . show . pretty) (symbolSource sym) | 267 | -- mapM_ (putStrLn . show . pretty) (symbolSource sym) |
259 | forM_ (take 1 h) $ \hh -> do | 268 | let mprintHeader = do |
260 | putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh | 269 | hh <- listToMaybe h |
261 | putStrLn $ unwords (hname:as) ++ " =" | 270 | guard (isJust (oSelectFunction o) || isFunctionDecl c) |
262 | let bdy = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym | 271 | Just $ do |
263 | if oPrettyTree o | 272 | -- putStrLn $ show (fmap (const LT) c) |
264 | then forM_ bdy $ \d -> putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) $ d | 273 | putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh |
265 | else do | 274 | putStrLn $ unwords (hname:as) ++ " =" |
266 | let mhask = do | 275 | forM_ mprintHeader $ \printHeader -> do |
267 | xs <- sequence $ map grokStatement bdy | 276 | let bdy = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym |
268 | return $ foldr applyComputation (Computation Map.empty Map.empty hsopUnit) xs | 277 | if oPrettyTree o |
269 | case mhask of | 278 | then do printHeader |
270 | Just hask -> mapM_ (putStrLn . (" "++)) $ lines $ HS.prettyPrint $ comp hask | 279 | forM_ bdy $ \d -> putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) $ d |
271 | Nothing -> forM_ bdy $ \d -> do | 280 | else do |
281 | let mhask = do | ||
282 | xs <- sequence $ map grokStatement bdy | ||
283 | return $ foldr applyComputation (Computation Map.empty Map.empty hsopUnit) xs | ||
284 | case mhask of | ||
285 | Just hask -> do printHeader | ||
286 | mapM_ (putStrLn . (" "++)) $ lines $ HS.prettyPrint $ comp hask | ||
287 | Nothing -> forM_ (oSelectFunction o) $ \_ -> do | ||
288 | printHeader | ||
289 | forM_ bdy $ \d -> do | ||
272 | putStrLn . show . pretty $ d | 290 | putStrLn . show . pretty $ d |
273 | mapM_ (putStrLn . HS.prettyPrint . comp) (grokStatement d) | 291 | mapM_ (putStrLn . HS.prettyPrint . comp) (grokStatement d) |
274 | return () | 292 | return () |