diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-23 23:56:50 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-23 23:56:50 -0400 |
commit | dd3d50853b422014de16df23bd914fc6de790ea8 (patch) | |
tree | f265fc1b1fb8cf588c771ab8c03395e66c0b8fda | |
parent | e960f50e4f1c5e35cc0f9e0d216c8d8caad0eb92 (diff) |
grok reading a field from a struct or ptr.
-rw-r--r-- | monkeypatch.hs | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index 5228dce..8e2dcf8 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -431,9 +431,22 @@ grokExpression fe (CAssign CAssignOp cvar expr _) = do | |||
431 | $ Lambda () [hspvar v] (hsvar k) | 431 | $ Lambda () [hspvar v] (hsvar k) |
432 | } | 432 | } |
433 | return $ (,) (ss ++ [s]) $ mkcomp (hsvar v) | 433 | return $ (,) (ss ++ [s]) $ mkcomp (hsvar v) |
434 | grokExpression fe (CMember cvar fld isptr _) = do | ||
435 | v <- cvarName cvar | ||
436 | let fieldlbl = identToString fld | ||
437 | hv = v ++ fieldlbl | ||
438 | e = App () (App () (hsvar "get") | ||
439 | (TypeApp () (TyPromoted () (PromotedString () fieldlbl fieldlbl)))) | ||
440 | (hsvar v) | ||
441 | e' = (mkcomp e){ compFree = Map.singleton v () } | ||
442 | k = uniqIdentifier "go" (varmap [hv,v,fieldlbl]) | ||
443 | s = (FormalLambda k <$> fmap (($ Lambda () [hspvar hv] (hsvar k)) . (`infixOp` ">>=")) e') | ||
444 | { compIntro = Map.singleton hv () } | ||
445 | return $ (,) [s] (mkcomp $ hsvar hv){ compFree = Map.singleton hv () } | ||
434 | grokExpression fe _ = Nothing | 446 | grokExpression fe _ = Nothing |
435 | 447 | ||
436 | 448 | ||
449 | |||
437 | grokInitialization :: Foldable t1 => | 450 | grokInitialization :: Foldable t1 => |
438 | FunctionEnvironment | 451 | FunctionEnvironment |
439 | -> t1 (CDeclarationSpecifier t2) | 452 | -> t1 (CDeclarationSpecifier t2) |