diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-19 18:55:40 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-19 18:55:40 -0400 |
commit | dd869e9bb65298a69a7a55bcb77990cebce210a7 (patch) | |
tree | 0807abd0d9a152f243ffb6067ffd7d2a1ae838be /monkeypatch.hs | |
parent | 42f56c9c4ffdc30fbc60e3c6b3a3534a4da57cc7 (diff) |
sigs
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index 58c8799..54b9f47 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -153,14 +153,18 @@ hsvar v = Var () (UnQual () (HS.Ident () v)) | |||
153 | hspvar :: String -> HS.Pat () | 153 | hspvar :: String -> HS.Pat () |
154 | hspvar v = PVar () (HS.Ident () v) | 154 | hspvar v = PVar () (HS.Ident () v) |
155 | 155 | ||
156 | cvarName :: CExpression a -> Maybe String | ||
156 | cvarName (CVar (C.Ident n _ _) _) = Just n | 157 | cvarName (CVar (C.Ident n _ _) _) = Just n |
157 | cvarName _ = Nothing | 158 | cvarName _ = Nothing |
158 | 159 | ||
160 | hsopUnit :: HS.Exp () | ||
159 | hsopUnit = HS.Con () (Special () (UnitCon ())) | 161 | hsopUnit = HS.Con () (Special () (UnitCon ())) |
160 | 162 | ||
161 | 163 | ||
164 | infixOp :: HS.Exp () -> String -> HS.Exp () -> HS.Exp () | ||
162 | infixOp x op y = InfixApp () x (QVarOp () (UnQual () (Symbol () op))) y | 165 | infixOp x op y = InfixApp () x (QVarOp () (UnQual () (Symbol () op))) y |
163 | 166 | ||
167 | infixFn :: HS.Exp () -> String -> HS.Exp () -> HS.Exp () | ||
164 | infixFn x fn y = InfixApp () x (QVarOp () (UnQual () (HS.Ident () fn))) y | 168 | infixFn x fn y = InfixApp () x (QVarOp () (UnQual () (HS.Ident () fn))) y |
165 | 169 | ||
166 | 170 | ||
@@ -191,6 +195,8 @@ varmap vs = Map.fromList $ map (,()) vs | |||
191 | 195 | ||
192 | -- Returns a list of statements bringing variables into scope and an | 196 | -- Returns a list of statements bringing variables into scope and an |
193 | -- expression. | 197 | -- expression. |
198 | grokExpression :: CExpression a | ||
199 | -> Maybe ([Computation (HS.Exp ())], Computation (HS.Exp ())) | ||
194 | grokExpression (CVar cv _) = Just $ (,) [] $ Computation | 200 | grokExpression (CVar cv _) = Just $ (,) [] $ Computation |
195 | { compFree = Map.singleton (identToString cv) () | 201 | { compFree = Map.singleton (identToString cv) () |
196 | , compIntro = Map.empty | 202 | , compIntro = Map.empty |
@@ -282,6 +288,10 @@ grokExpression (C.CCall (CVar fn _) exps _) = do | |||
282 | grokExpression _ = Nothing | 288 | grokExpression _ = Nothing |
283 | 289 | ||
284 | 290 | ||
291 | grokInitialization :: Foldable t1 => | ||
292 | t1 (CDeclarationSpecifier t2) | ||
293 | -> (Maybe (CDeclarator a1), CInitializer a2) | ||
294 | -> Maybe (Computation (HS.Exp ())) | ||
285 | grokInitialization _ (Just (CDeclr (Just cv0) _ _ _ _),CInitExpr exp _) = do | 295 | grokInitialization _ (Just (CDeclr (Just cv0) _ _ _ _),CInitExpr exp _) = do |
286 | let v = identToString cv0 | 296 | let v = identToString cv0 |
287 | (xs,x) <- grokExpression exp | 297 | (xs,x) <- grokExpression exp |
@@ -389,6 +399,7 @@ grokStatement (CBlockDecl (CDecl (t:ts) (v:vs) _)) = do | |||
389 | $ foldr applyComputation (Computation Map.empty Map.empty (hsvar "go")) gs | 399 | $ foldr applyComputation (Computation Map.empty Map.empty (hsvar "go")) gs |
390 | grokStatement _ = Nothing | 400 | grokStatement _ = Nothing |
391 | 401 | ||
402 | isFunctionDecl :: CExternalDeclaration a -> Bool | ||
392 | isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True | 403 | isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True |
393 | isFunctionDecl (CFDefExt (CFunDef _ _ _ (CCompound [] _ _) _)) = True | 404 | isFunctionDecl (CFDefExt (CFunDef _ _ _ (CCompound [] _ _) _)) = True |
394 | isFunctionDecl _ = False | 405 | isFunctionDecl _ = False |
@@ -801,11 +812,13 @@ enumCases (CDeclExt (CDecl xs _ ni)) = do | |||
801 | CTypeSpec (CEnumType (CEnum _ (Just cs) _ _) _) <- xs | 812 | CTypeSpec (CEnumType (CEnum _ (Just cs) _ _) _) <- xs |
802 | return (ni,cs) | 813 | return (ni,cs) |
803 | 814 | ||
815 | lineOfComment :: (Int, b, String) -> Int | ||
804 | lineOfComment (l,_,s) = l + length (lines s) | 816 | lineOfComment (l,_,s) = l + length (lines s) |
805 | 817 | ||
806 | seekComment :: NodeInfo -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)]) | 818 | seekComment :: NodeInfo -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)]) |
807 | seekComment ni cs = break (\c -> lineOfComment c>=posRow (posOfNode ni)) cs | 819 | seekComment ni cs = break (\c -> lineOfComment c>=posRow (posOfNode ni)) cs |
808 | 820 | ||
821 | strip :: [Char] -> [Char] | ||
809 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace | 822 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace |
810 | 823 | ||
811 | 824 | ||