Skip to content

Commit

Permalink
[mmzk] (refactor) Remove unnecessary Readers
Browse files Browse the repository at this point in the history
  • Loading branch information
MMZK1526 committed Oct 10, 2023
1 parent 292441f commit 24e068d
Show file tree
Hide file tree
Showing 2 changed files with 10 additions and 15 deletions.
10 changes: 3 additions & 7 deletions src/Year2015/Exam.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,8 @@
{-# LANGUAGE InstanceSigs #-}

module Year2015.Exam where
import Debug.Trace

import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Strict as S
import Data.List
import Data.Maybe
Expand Down Expand Up @@ -137,7 +136,7 @@ executeStatement :: Statement -> [FunDef] -> [ProcDef] -> State -> State
-- Pre: All statements are well formed
-- Pre: For array element assignment (AssignA) the array variable is in scope,
-- i.e. it has a binding in the given state
executeStatement stmt' fDefs pDefs st' = runReader (S.execStateT (worker stmt') st') (fDefs, pDefs)
executeStatement stmt' fDefs pDefs st' = S.execState (worker stmt') st'
where
worker (Assign v e) = do
st <- S.get
Expand All @@ -147,13 +146,11 @@ executeStatement stmt' fDefs pDefs st' = runReader (S.execStateT (worker stmt')
let arr = assignArray (getValue v st) (eval i fDefs st) (eval e fDefs st)
S.put $ updateVar (v, arr) st
worker (If e b1 b2) = do
(fDefs, pDefs) <- lift ask
st <- S.get
case eval e fDefs st of
I 0 -> mapM_ worker b2
_ -> mapM_ worker b1
worker stmt@(While e b) = do
(fDefs, pDefs) <- lift ask
st <- S.get
case eval e fDefs st of
I 0 -> pure ()
Expand Down Expand Up @@ -187,8 +184,7 @@ translate (name, (as, e)) newName nameMap
(b, e', ids') = translate' e nameMap ['$' : show n | n <- [1..]]

translate' :: Exp -> [(Id, Id)] -> [Id] -> (Block, Exp, [Id])
translate' exp nameMap ids
= uncurry' $ runReader (S.runStateT (worker exp) ids) nameMap
translate' exp nameMap ids = uncurry' (S.runState (worker exp) ids)
where
uncurry' ((a, b), c) = (a, b, c)
getFresh = S.state $ \(i : is) -> (i, is)
Expand Down
15 changes: 7 additions & 8 deletions src/Year2019/SOL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@ module Year2019.SOL where
-- > the original one. This is what modern SAT solvers do.

import Control.Monad
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Data.List
import Data.Tuple
Expand Down Expand Up @@ -96,14 +95,14 @@ toCNF = toCNF' . toNNF
-- 4 marks
flatten :: CNF -> CNFRep
-- > The idea is very similar to parser combinators :)
flatten f = runReader (flattenAnd f) (idMap f)
flatten f = flattenAnd f
where
flattenAnd (And f f') = liftM2 (++) (flattenAnd f) (flattenAnd f')
flattenAnd f = pure <$> flattenOr f
flattenOr (Or f f') = liftM2 (++) (flattenOr f) (flattenOr f')
flattenOr f = pure <$> flattenVar f
flattenVar (Var v) = lookUp v <$> ask
flattenVar (Not f) = negate <$> flattenVar f
flattenAnd (And f f') = flattenAnd f ++ flattenAnd f'
flattenAnd f = [flattenOr f]
flattenOr (Or f f') = flattenOr f ++ flattenOr f'
flattenOr f = [flattenVar f]
flattenVar (Var v) = lookUp v (idMap f)
flattenVar (Not f) = negate (flattenVar f)


--------------------------------------------------------------------------
Expand Down

0 comments on commit 24e068d

Please sign in to comment.