Skip to content
Snippets Groups Projects
Commit d0ff68c4 authored by chrg's avatar chrg
Browse files

Add labels

parent d5e2e68d
Branches
No related tags found
No related merge requests found
......@@ -7,10 +7,10 @@
module Data.Expr where
import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Reduce
import Control.Monad.State
import Data.Data
import Data.Functor
import qualified Data.Map.Strict as Map
import Test.Hspec
......@@ -39,26 +39,36 @@ contains fn e =
Nothing -> False
rExpr
:: (MonadReducePlus m, MonadState (Map.Map String (Either String Expr)) m)
:: (MonadReduce String m, MonadReader (Map.Map String (Either String Expr)) m)
=> Expr
-> m Expr
rExpr e = case e of
Cnt i -> do
given $> Cnt i
pure $ Cnt i
Var k -> do
v <- liftMaybe =<< gets (Map.lookup k)
v <- asks (Map.lookup k)
case v of
Left k' -> given $> Var k'
Right x -> rExpr x
Opr e1 e2 -> onBoth (rExpr e1) (rExpr e2) $ \e1' e2' ->
Just (Left k') -> pure $ Var k'
Just (Right x) -> rExpr x
Nothing -> pure (Cnt 0)
Opr e1 e2 -> do
split "choose left" (rExpr e1) . split "choose right" (rExpr e2) $ do
e1' <- rExpr e1
e2' <- rExpr e2
case (e1', e2') of
(Cnt a, Cnt b) -> pure (Cnt (a + b)) <| pure (Opr e1' e2')
(Cnt n1, Cnt n2) -> do
let opr = Opr e1' e2'
split
("compute " <> prettyExprS 0 opr "")
(pure (Cnt (n1 + n2)))
(pure (Opr e1' e2'))
_ow -> pure $ Opr e1' e2'
Let k e1 e2 -> do
e1' <- rExpr e1
split
(modifyIn (Map.insert k (Right e1')) $ rExpr e2)
(Let k e1' <$> modifyIn (Map.insert k (Left k)) (rExpr e2))
("inline " <> show k)
(local (Map.insert k (Right e1')) $ rExpr e2)
(Let k e1' <$> local (Map.insert k (Left k)) (rExpr e2))
modifyIn :: (Alternative m, MonadState s m) => (s -> s) -> m b -> m b
modifyIn fn mx = do
......
......@@ -59,7 +59,7 @@ instance Example GitGolden where
( Failure
location
( Reason
(unlines . drop 4 . lines $ df)
(unlines . drop 3 . lines $ df)
)
)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment