diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-18 20:20:50 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-18 20:20:50 -0400 |
commit | 1541cb7d36aa8aff07ac4a45fa467e131408c8df (patch) | |
tree | e0b9083c8da26b5f4517f0786e973db92744db34 /monkeypatch.hs | |
parent | d7c3ede006e7a767bf5906e908d40caaa2951d4b (diff) |
Transpile code to create structs.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 37 |
1 files changed, 34 insertions, 3 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index beaa58f..d39ec98 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -10,6 +10,7 @@ | |||
10 | module Main where | 10 | module Main where |
11 | 11 | ||
12 | import Control.Arrow (left,first,second) | 12 | import Control.Arrow (left,first,second) |
13 | import Data.Either | ||
13 | import Data.Generics.Aliases | 14 | import Data.Generics.Aliases |
14 | import Data.Generics.Schemes | 15 | import Data.Generics.Schemes |
15 | import Debug.Trace | 16 | import Debug.Trace |
@@ -251,6 +252,33 @@ grokExpression (C.CCall (CVar fn _) exps _) = do | |||
251 | grokExpression _ = Nothing | 252 | grokExpression _ = Nothing |
252 | 253 | ||
253 | 254 | ||
255 | grokInitialization _ (Just (CDeclr (Just cv0) _ _ _ _),CInitExpr exp _) = do | ||
256 | let v = identToString cv0 | ||
257 | (xs,x) <- grokExpression exp | ||
258 | let hsexp = fmap (App () (hsvar "return")) x -- Paren () ( | ||
259 | ret = flip (foldr applyComputation) xs $ | ||
260 | fmap (\exp -> InfixApp () exp hsopBind | ||
261 | $ Lambda () [hspvar v] (hsvar k)) hsexp | ||
262 | k = uniqIdentifier "go" (compFree ret) | ||
263 | return $ fmap (\exp -> Lambda () [hspvar k] exp) ret | ||
264 | grokInitialization ts (Just (CDeclr (Just cv0) _ _ _ _),CInitList exps _) = do | ||
265 | let v = identToString cv0 | ||
266 | let k = uniqIdentifier "go" (varmap [v]) | ||
267 | case lefts $ concatMap hsTypeSpec ts of | ||
268 | (ident:_) -> | ||
269 | -- TODO: intialize fields. | ||
270 | let hident = HS.Ident () $ capitalize $ identToString ident | ||
271 | in return Computation | ||
272 | { compFree = Map.empty -- todo | ||
273 | , compIntro = Map.singleton v () | ||
274 | , comp = Lambda () [hspvar k] | ||
275 | $ InfixApp () (App () (hsvar "newStruct") (TypeApp () (TyCon () (UnQual () hident)))) hsopBind | ||
276 | $ Lambda () [hspvar v] (hsvar k) | ||
277 | } | ||
278 | _ -> Nothing | ||
279 | grokInitialization _ _ = Nothing | ||
280 | |||
281 | |||
254 | grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ())) | 282 | grokStatement :: CCompoundBlockItem a -> Maybe (Computation (HS.Exp ())) |
255 | grokStatement (CBlockStmt (CReturn (Just exp) _)) = do | 283 | grokStatement (CBlockStmt (CReturn (Just exp) _)) = do |
256 | (xs,x) <- grokExpression exp | 284 | (xs,x) <- grokExpression exp |
@@ -280,17 +308,20 @@ grokStatement (CBlockStmt (CIf exp (CCompound [] stmts _) Nothing _)) = do | |||
280 | , compIntro = compIntro s | 308 | , compIntro = compIntro s |
281 | , comp = Lambda () [hspvar k] $ If () (comp x) (comp s) (hsvar k) | 309 | , comp = Lambda () [hspvar k] $ If () (comp x) (comp s) (hsvar k) |
282 | } | 310 | } |
283 | grokStatement (CBlockDecl (CDecl (t:_) (v:vs) _)) = do | 311 | grokStatement (CBlockDecl (CDecl (t:ts) (v:vs) _)) = do |
284 | -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CDeclr i _ initial _ _) -> initial) (v:vs) of | 312 | -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CDeclr i _ initial _ _) -> initial) (v:vs) of |
285 | -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CInitList xs _) -> Just xs) (v:vs) of | 313 | -- case mapMaybe (\(cdeclr,_,_) -> cdeclr >>= \(CInitList xs _) -> Just xs) (v:vs) of |
286 | case mapMaybe (\(_,inits,_) -> inits) (v:vs) of | 314 | case mapMaybe (\(i,inits,_) -> fmap ((,) i) inits) (v:vs) of |
287 | [] -> | 315 | [] -> |
288 | return Computation | 316 | return Computation |
289 | { compFree = Map.empty | 317 | { compFree = Map.empty |
290 | , compIntro = Map.empty | 318 | , compIntro = Map.empty |
291 | , comp = Lambda () [hspvar "go"] $ hsvar "go" | 319 | , comp = Lambda () [hspvar "go"] $ hsvar "go" |
292 | } | 320 | } |
293 | initials -> Nothing -- TODO | 321 | initials -> do |
322 | gs <- mapM (grokInitialization $ t:ts) initials | ||
323 | return $ fmap (\exp -> Lambda () [hspvar "go"] exp) | ||
324 | $ foldr applyComputation (Computation Map.empty Map.empty (hsvar "go")) gs | ||
294 | grokStatement _ = Nothing | 325 | grokStatement _ = Nothing |
295 | 326 | ||
296 | isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True | 327 | isFunctionDecl (CDeclExt (CDecl _ [(Just (CDeclr _ [CFunDeclr _ _ _] _ _ _),_,_)] _)) = True |