Commit 232c8c60 authored by Jente Hidskes's avatar Jente Hidskes

lib: rename old Fix transformers to LeastFixPoint

parent 07fa11c0
......@@ -13,7 +13,7 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -DTRACE #-}
module Control.Arrow.Transformer.Abstract.Fix(type (~>),runFix,runFix',liftFix) where
module Control.Arrow.Transformer.Abstract.LeastFixPoint(type (~>),runLeastFixPoint,runLeastFixPoint',liftLeastFixPoint) where
import Prelude hiding (id,(.),lookup)
import Data.Function (fix)
......@@ -41,54 +41,54 @@ import Text.Printf
-- We made some changes to the algorithm to simplify it.
data (~>) x y
type instance Fix a b (~>) = FixArrow a b
type instance Fix a b (~>) = LeastFixPointArrow a b
newtype FixArrow a b x y = FixArrow (((Store a (Terminating b), Store a (Terminating b)),x) -> (Store a (Terminating b), Terminating y))
newtype LeastFixPointArrow a b x y = LeastFixPointArrow (((Store a (Terminating b), Store a (Terminating b)),x) -> (Store a (Terminating b), Terminating y))
runFix :: Fix a b (~>) x y -> (x -> Terminating y)
runFix f = runFix' f >>^ snd
runLeastFixPoint :: Fix a b (~>) x y -> (x -> Terminating y)
runLeastFixPoint f = runLeastFixPoint' f >>^ snd
runFix' :: Fix a b (~>) x y -> (x -> (Store a (Terminating b), Terminating y))
runFix' (FixArrow f) = (\x -> ((S.empty,S.empty),x)) ^>> f
runLeastFixPoint' :: Fix a b (~>) x y -> (x -> (Store a (Terminating b), Terminating y))
runLeastFixPoint' (LeastFixPointArrow f) = (\x -> ((S.empty,S.empty),x)) ^>> f
liftFix :: (x -> y) -> FixArrow a b x y
liftFix f = FixArrow ((\((_,o),x) -> (o,x)) ^>> second (f ^>> Terminating))
liftLeastFixPoint :: (x -> y) -> LeastFixPointArrow a b x y
liftLeastFixPoint f = LeastFixPointArrow ((\((_,o),x) -> (o,x)) ^>> second (f ^>> Terminating))
instance Category (FixArrow i o) where
id = liftFix id
FixArrow f . FixArrow g = FixArrow $ proc ((i,o),x) -> do
instance Category (LeastFixPointArrow i o) where
id = liftLeastFixPoint id
LeastFixPointArrow f . LeastFixPointArrow g = LeastFixPointArrow $ proc ((i,o),x) -> do
(o',y) <- g -< ((i,o),x)
case y of
NonTerminating -> returnA -< (o,NonTerminating)
Terminating y' -> f -< ((i,o'),y')
instance Arrow (FixArrow i o) where
arr f = liftFix (arr f)
first (FixArrow f) = FixArrow $ to assoc ^>> first f >>^ (\((o,x'),y) -> (o,strength1 (x',y)))
instance Arrow (LeastFixPointArrow i o) where
arr f = liftLeastFixPoint (arr f)
first (LeastFixPointArrow f) = LeastFixPointArrow $ to assoc ^>> first f >>^ (\((o,x'),y) -> (o,strength1 (x',y)))
instance ArrowChoice (FixArrow i o) where
left (FixArrow f) = FixArrow $ \((i,o),e) -> case e of
instance ArrowChoice (LeastFixPointArrow i o) where
left (LeastFixPointArrow f) = LeastFixPointArrow $ \((i,o),e) -> case e of
Left x -> second (fmap Left) (f ((i,o),x))
Right y -> (o,return (Right y))
right (FixArrow f) = FixArrow $ \((i,o),e) -> case e of
right (LeastFixPointArrow f) = LeastFixPointArrow $ \((i,o),e) -> case e of
Left x -> (o,return (Left x))
Right y -> second (fmap Right) (f ((i,o),y))
FixArrow f ||| FixArrow g = FixArrow $ \((i,o),e) -> case e of
LeastFixPointArrow f ||| LeastFixPointArrow g = LeastFixPointArrow $ \((i,o),e) -> case e of
Left x -> f ((i,o),x)
Right y -> g ((i,o),y)
instance ArrowLoop (FixArrow i o) where
loop (FixArrow f) = FixArrow $ loop $ \(((i,o),b),d) ->
instance ArrowLoop (LeastFixPointArrow i o) where
loop (LeastFixPointArrow f) = LeastFixPointArrow $ loop $ \(((i,o),b),d) ->
case f ((i,o),(b,d)) of
(o',Terminating (c,d')) -> ((o',Terminating c),d')
(o',NonTerminating) -> ((o',NonTerminating),d)
instance ArrowApply (FixArrow i o) where
app = FixArrow $ (\(io,(FixArrow f,x)) -> (f,(io,x))) ^>> app
instance ArrowApply (LeastFixPointArrow i o) where
app = LeastFixPointArrow $ (\(io,(LeastFixPointArrow f,x)) -> (f,(io,x))) ^>> app
#ifdef TRACE
instance (Show x, Show y, Identifiable x, Widening y)
=> ArrowFix x y (FixArrow x y) where
=> ArrowFix x y (LeastFixPointArrow x y) where
fixA f = trace (printf "fixA f") $ proc x -> do
old <- getOutCache -< ()
setOutCache -< bottom
......@@ -98,8 +98,8 @@ instance (Show x, Show y, Identifiable x, Widening y)
then returnA -< y
else fixA f -< x
memoize :: (Show x, Show y, Identifiable x, Widening y) => FixArrow x y x y -> FixArrow x y x y
memoize (FixArrow f) = FixArrow $ \((inCache, outCache),x) -> do
memoize :: (Show x, Show y, Identifiable x, Widening y) => LeastFixPointArrow x y x y -> LeastFixPointArrow x y x y
memoize (LeastFixPointArrow f) = LeastFixPointArrow $ \((inCache, outCache),x) -> do
case trace (printf "\tmemoize -< %s" (show x)) (S.lookup x outCache) of
Success y -> trace (printf "\t%s <- memoize -< %s" (show y) (show x)) (outCache,y)
Fail _ ->
......@@ -112,7 +112,7 @@ memoize (FixArrow f) = FixArrow $ \((inCache, outCache),x) -> do
(outCache''',y)
#else
instance (Identifiable x, Widening y) => ArrowFix x y (FixArrow x y) where
instance (Identifiable x, Widening y) => ArrowFix x y (LeastFixPointArrow x y) where
fixA f = proc x -> do
old <- getOutCache -< ()
setOutCache -< bottom
......@@ -122,8 +122,8 @@ instance (Identifiable x, Widening y) => ArrowFix x y (FixArrow x y) where
then returnA -< y
else fixA f -< x
memoize :: (Identifiable x, Widening y) => FixArrow x y x y -> FixArrow x y x y
memoize (FixArrow f) = FixArrow $ \((inCache, outCache),x) -> do
memoize :: (Identifiable x, Widening y) => LeastFixPointArrow x y x y -> LeastFixPointArrow x y x y
memoize (LeastFixPointArrow f) = LeastFixPointArrow $ \((inCache, outCache),x) -> do
case S.lookup x outCache of
Success y -> (outCache,y)
Fail _ ->
......@@ -133,17 +133,17 @@ memoize (FixArrow f) = FixArrow $ \((inCache, outCache),x) -> do
in (S.insertWith (flip ()) x y outCache'',y)
#endif
getOutCache :: FixArrow x y () (Store x (Terminating y))
getOutCache = FixArrow $ (\((_,o),()) -> (o,return o))
getOutCache :: LeastFixPointArrow x y () (Store x (Terminating y))
getOutCache = LeastFixPointArrow $ (\((_,o),()) -> (o,return o))
setOutCache :: FixArrow x y (Store x (Terminating y)) ()
setOutCache = FixArrow $ (\((_,_),o) -> (o,return ()))
setOutCache :: LeastFixPointArrow x y (Store x (Terminating y)) ()
setOutCache = LeastFixPointArrow $ (\((_,_),o) -> (o,return ()))
localInCache :: FixArrow x y x y -> FixArrow x y (Store x (Terminating y),x) y
localInCache (FixArrow f) = FixArrow (\((_,o),(i,x)) -> f ((i,o),x))
localInCache :: LeastFixPointArrow x y x y -> LeastFixPointArrow x y (Store x (Terminating y),x) y
localInCache (LeastFixPointArrow f) = LeastFixPointArrow (\((_,o),(i,x)) -> f ((i,o),x))
deriving instance (Identifiable a, PreOrd b, PreOrd y) => PreOrd (FixArrow a b x y)
deriving instance (Identifiable a, Complete b, Complete y) => Complete (FixArrow a b x y)
deriving instance (Identifiable a, CoComplete b, CoComplete y) => CoComplete (FixArrow a b x y)
deriving instance (Identifiable a, PreOrd b, PreOrd y) => LowerBounded (FixArrow a b x y)
-- deriving instance (Identifiable a, UpperBounded b, UpperBounded y) => UpperBounded (Fix a b x y)
deriving instance (Identifiable a, PreOrd b, PreOrd y) => PreOrd (LeastFixPointArrow a b x y)
deriving instance (Identifiable a, Complete b, Complete y) => Complete (LeastFixPointArrow a b x y)
deriving instance (Identifiable a, CoComplete b, CoComplete y) => CoComplete (LeastFixPointArrow a b x y)
deriving instance (Identifiable a, PreOrd b, PreOrd y) => LowerBounded (LeastFixPointArrow a b x y)
-- deriving instance (Identifiable a, UpperBounded b, UpperBounded y) => UpperBounded (LeastFixPoint a b x y)
{-# LANGUAGE TypeFamilies #-}
module Control.Arrow.Transformer.Concrete.Fix(Fix,runFix) where
module Control.Arrow.Transformer.Concrete.LeastFixPoint(Fix,runLeastFixPoint) where
import Prelude hiding ((.))
......@@ -7,5 +7,5 @@ import Control.Arrow.Fix
type instance Fix a b (->) = (->)
runFix :: Fix a b (->) x y -> x -> y
runFix f = f
runLeastFixPoint :: Fix a b (->) x y -> x -> y
runLeastFixPoint f = f
......@@ -83,14 +83,14 @@ library
Control.Arrow.Transformer.Concrete.Environment,
Control.Arrow.Transformer.Concrete.Except,
Control.Arrow.Transformer.Concrete.Fix,
Control.Arrow.Transformer.Concrete.LeastFixPoint,
Control.Arrow.Transformer.Concrete.Store,
Control.Arrow.Transformer.Abstract.Environment,
Control.Arrow.Transformer.Abstract.Contour,
Control.Arrow.Transformer.Abstract.BoundedEnvironment,
Control.Arrow.Transformer.Abstract.Except,
Control.Arrow.Transformer.Abstract.Fix,
Control.Arrow.Transformer.Abstract.LeastFixPoint,
Control.Arrow.Transformer.Abstract.Powerset,
Control.Arrow.Transformer.Abstract.Store,
-- Control.Arrow.Transformer.Abstract.LiveVariables,
......
......@@ -12,7 +12,7 @@ import Prelude hiding (lookup,Bounded,Bool(..))
import Control.Arrow
import Control.Arrow.Fix
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.State
import Control.Arrow.Fail
......@@ -59,8 +59,8 @@ spec = do
returnA -< x + y))
in it "should memoize numbers that have been computed before already" $ do
runFix (fixA fib :: Cache IV IV) (bounded (I.Interval 5 10)) `shouldBe` return (bounded (I.Interval 5 55))
runFix (fixA fib :: Cache IV IV) (bounded (I.Interval 0 Infinity)) `shouldBe` return (bounded top)
runLeastFixPoint (fixA fib :: Cache IV IV) (bounded (I.Interval 5 10)) `shouldBe` return (bounded (I.Interval 5 55))
runLeastFixPoint (fixA fib :: Cache IV IV) (bounded (I.Interval 0 Infinity)) `shouldBe` return (bounded top)
describe "the analysis of the factorial function" $
let ?bound = top in
......@@ -68,7 +68,7 @@ spec = do
ifLowerThan 1 (proc _ -> returnA -< bounded (I.Interval 1 1))
(proc n -> do {x <- f -< (n-bounded (I.Interval 1 1)); returnA -< n * x}) -< n
in it "fact [-inf,inf] should produce [1,inf]" $
runFix (fixA fact :: Cache IV IV) (bounded top)
runLeastFixPoint (fixA fact :: Cache IV IV) (bounded top)
`shouldBe` return (bounded (I.Interval 1 Infinity))
describe "the even and odd functions" $
......@@ -82,7 +82,7 @@ spec = do
(ifLowerThan 1 (proc _ -> returnA -< true)
(proc x -> f -< (Even,x-bounded (I.Interval 1 1)))) -< x
in it "even([-inf,inf]) should produce top" $
runFix (fixA evenOdd) (Even,bounded (I.Interval 0 Infinity)) `shouldBe` top
runLeastFixPoint (fixA evenOdd) (Even,bounded (I.Interval 0 Infinity)) `shouldBe` top
describe "the ackermann function" $
let ?bound = I.Interval (-50) 50 in
......@@ -96,7 +96,7 @@ spec = do
f -< (m'- bounded (I.Interval 1 1), x)) -<< n)
-<< m
in it "ackerman ([0,inf], [0,inf]) should be [0,inf] " $ do
runFix (fixA ackermann) (bounded (I.Interval 0 Infinity), bounded (I.Interval 0 Infinity))
runLeastFixPoint (fixA ackermann) (bounded (I.Interval 0 Infinity), bounded (I.Interval 0 Infinity))
`shouldBe` return (bounded top)
describe "the analyis of a diverging program" $
......@@ -105,7 +105,7 @@ spec = do
0 -> f -< 0
_ -> f -< (n-1)
in it "should terminate with bottom" $
runFix (fixA diverge) 5
runLeastFixPoint (fixA diverge) 5
`shouldBe` bottom
describe "the analysis of a failing program" $
......@@ -114,7 +114,7 @@ spec = do
0 -> failA -< ()
_ -> f -< (n-1)
in it "should fail, but update the fixpoint cache" $
runFix' (runExcept (fixA recurseFail)) 5
runLeastFixPoint' (runExcept (fixA recurseFail)) 5
`shouldBe` (S.fromList [(n,Terminating (Fail ())) | n <- [0..5]], return (Fail ()))
describe "the analysis of a stateful program" $
......@@ -129,7 +129,7 @@ spec = do
s' <- getA -< ()
putA -< s'+ bounded (I.Interval 1 1)
in it "should cache the state of the program" $
runFix' (runState (fixA timesTwo)) (bounded 0, bounded 5) `shouldBe`
runLeastFixPoint' (runState (fixA timesTwo)) (bounded 0, bounded 5) `shouldBe`
(S.fromList [((bounded (fromIntegral n),bounded 5-bounded (fromIntegral n)),
return (bounded 10-bounded (fromIntegral n),())) | n <- [0..5::Int]],
return (bounded 10,()))
......
......@@ -22,7 +22,7 @@ import Control.Arrow.Transformer.Abstract.LiveVariables
import qualified Control.Arrow.Transformer.Abstract.LiveVariables as L
import Control.Arrow.Transformer.Abstract.Store
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Data.Text (Text)
import Data.Hashable
......@@ -141,7 +141,7 @@ runAnalysis ss =
((i,_):_) ->
let trans = (fst (snd (fromError (error "error") (fromTerminating (error "non terminating") q))))
in Just (i,(L.entry trans, L.exit trans))) $
fst $ runFix' (runExcept (runStore (runLiveVariables (runInterp (run :: Interp [(Int,Statement)] ()))))) (S.empty,ss)
fst $ runLeastFixPoint' (runExcept (runStore (runLiveVariables (runInterp (run :: Interp [(Int,Statement)] ()))))) (S.empty,ss)
instance Hashable Statement
instance Hashable Expr
......
......@@ -15,7 +15,7 @@ import Control.Arrow.Environment
import Control.Arrow.Fix
import Control.Arrow.Transformer.Concrete.Environment
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.Concrete.Fix
import Control.Arrow.Transformer.Concrete.LeastFixPoint
import Control.Monad.State
import Data.Concrete.Error
......@@ -35,7 +35,7 @@ data Val = NumVal Int | ClosureVal Closure deriving (Eq,Generic)
newtype Interp x y = Interp (Fix Expr Val (Environment Text Val (Except String (->))) x y)
runInterp :: Interp x y -> [(Text,Val)] -> x -> Error String y
runInterp (Interp f) env x = runFix (runExcept (runEnvironment f)) (env,x)
runInterp (Interp f) env x = runLeastFixPoint (runExcept (runEnvironment f)) (env,x)
evalConcrete :: [(Text,Val)] -> State Label Expr -> Error String Val
evalConcrete env e = runInterp eval env (generate e)
......
......@@ -22,7 +22,7 @@ import Control.Arrow.Environment
import Control.Arrow.Transformer.Abstract.Contour hiding (toList)
import Control.Arrow.Transformer.Abstract.BoundedEnvironment
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Arrow.Transformer.Const
import Control.Monad.State hiding (lift)
......@@ -73,7 +73,7 @@ newtype Interp x y =
runInterp :: Interp x y -> IV -> Int -> [(Text,Val)] -> x -> Terminating (Error String y)
runInterp (Interp f) b k env x =
runFix
runLeastFixPoint
(runExcept
(runContourArrow k
(runEnvironment
......
......@@ -44,10 +44,10 @@ initState = (initStore, initCProp, mkStdGen 0)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,CProp)
run = fmap ((\(st,pr,_) -> (st,reverse pr)) . fst) . runM
......
......@@ -41,10 +41,10 @@ initState = (initStore, initAProp)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,AProp Val)
run = fmap fst . runM
......
......@@ -28,7 +28,7 @@ import Control.Arrow.Lift
import Control.Arrow.Transformer.Writer
import Control.Arrow.Transformer.Abstract.LiveVariables
import qualified Control.Arrow.Transformer.Abstract.LiveVariables as L
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Monad.State(State)
run :: (?bound :: IV) => [State Label Statement] -> [(Statement,(LiveVars Text,LiveVars Text))]
......@@ -42,7 +42,7 @@ run statements =
let trans = fst (snd (fromError (error "error") (fromTerminating (error "non terminating") v)))
in Just (s,(L.entry trans, L.exit trans))) $
fst $
runFix'
runLeastFixPoint'
(runInterp ?bound
(runLiveVariables (Shared.run :: Fix [Statement] () (LiveVariables Text (Interp (~>))) [Statement] ())))
(S.empty,generate (sequence statements))
......
......@@ -26,7 +26,7 @@ import Control.Arrow.Lift
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Writer
import Control.Arrow.Transformer.Abstract.ReachingDefinitions
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
run :: [Statement] -> ReachingDefs Text Label -> [(Statement,(ReachingDefs Text Label,ReachingDefs Text Label))]
run stmts defs =
......@@ -40,7 +40,7 @@ run stmts defs =
_ -> Nothing;
) $
fst $
runFix'
runLeastFixPoint'
(runInterp
(runReachingDefinitions
(Shared.run :: Fix [Statement] () (ReachingDefinitions Text Label (Interp (~>))) [Statement] ())))
......
......@@ -35,7 +35,7 @@ type Interp = PropertyArrow CProp Concrete.Interp
runInterp :: [Statement] -> Error String (State,CProp)
runInterp ss =
second fst <$>
runFix (runErrorArrow (runStateArrow (runProperty run)))
runLeastFixPoint (runErrorArrow (runStateArrow (runProperty run)))
((initStore, mkStdGen 0), (initCProp, ss))
instance HasStore Interp Store where
......
......@@ -39,10 +39,10 @@ initState = (initStore, initAProp)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,AProp)
run = fmap fst . runM
......
......@@ -46,10 +46,10 @@ initState = (initStore, initTrace, mkStdGen 0)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,Trace)
run = fmap ((\(st,pr,_) -> (st,reverse pr)) . fst) . runM
......
......@@ -50,10 +50,10 @@ initState = (initStore, bottom, mkStdGen 0)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,FDeadStores)
run = fmap ((\(st,pr,_) -> (st,finalizeDeadStores pr)) . fst) . runM
......
......@@ -50,10 +50,10 @@ initState = (initStore, bottom)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,FDeadStores)
run = fmap (second finalizeDeadStores . fst) . runM
......
......@@ -42,10 +42,10 @@ initState = (initStore, liftTrace initTrace)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,LiftedTrace)
run = fmap (second (fmap reverse) . fst) . runM
......
......@@ -44,10 +44,10 @@ initState = (initStore, bottom, mkStdGen 0)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,Prop)
run = fmap ((\(st,pr,_) -> (st,pr)) . fst) . runM
......
......@@ -44,10 +44,10 @@ initState = (initStore, bottom)
type In a = (State,a)
type Out a = Error String (State,a)
type M = StateArrow State (ErrorArrow String (Fix (In [Statement]) (Out ())))
type M = StateArrow State (ErrorArrow String (LeastFixPoint (In [Statement]) (Out ())))
runM :: [Statement] -> Error String (State,())
runM ss = runFix (runErrorArrow (runStateArrow L.run)) (initState, ss)
runM ss = runLeastFixPoint (runErrorArrow (runStateArrow L.run)) (initState, ss)
run :: [Statement] -> Error String (Store,Prop)
run = fmap fst . runM
......
......@@ -32,7 +32,7 @@ import Control.Arrow.Store
import Control.Arrow.Transformer.State
import Control.Arrow.Transformer.Concrete.Except
import Control.Arrow.Transformer.Concrete.Store
import Control.Arrow.Transformer.Concrete.Fix(runFix)
import Control.Arrow.Transformer.Concrete.LeastFixPoint(runLeastFixPoint)
import System.Random
......@@ -46,7 +46,7 @@ runInterp :: Interp c x y -> c (Store Text Val, (StdGen,x)) (Error String (Store
runInterp (Interp f) = runExcept (runStore (runState f))
run :: [Statement] -> Error String (Store Text Val)
run ss = fst <$> runFix (runInterp (Shared.run :: Fix [Statement] () (Interp (->)) [Statement] ())) (S.empty,(mkStdGen 0,ss))
run ss = fst <$> runLeastFixPoint (runInterp (Shared.run :: Fix [Statement] () (Interp (->)) [Statement] ())) (S.empty,(mkStdGen 0,ss))
instance ArrowChoice c => IsVal Val (Interp c) where
boolLit = arr (\(b,_) -> BoolVal b)
......
......@@ -32,7 +32,7 @@ import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Store
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Arrow.Transformer.Abstract.Store
import Control.Monad.State
......@@ -45,7 +45,7 @@ runInterp :: Interp c x y -> c (Store Text Val,x) (Error String (Store Text Val,
runInterp (Interp f) = runExcept (runStore f)
run :: [State Label Statement] -> Terminating (Error String (Store Text Val))
run ss = fmap fst <$> runFix (runInterp (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
run ss = fmap fst <$> runLeastFixPoint (runInterp (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
instance ArrowChoice c => IsVal Val (Interp c) where
boolLit = arr (const ())
......
......@@ -48,7 +48,7 @@ import Control.Arrow.Fix
import Control.Arrow.Store
import Control.Arrow.Transformer.Const
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Arrow.Transformer.Abstract.Store
import Control.Monad.State
......@@ -64,7 +64,7 @@ runInterp :: IV -> Interp c x y -> c (Store Text Val,x) (Error String (Store Tex
runInterp b (Interp f) = runExcept (runStore (runConst b f))
run :: (?bound :: IV) => [State Label Statement] -> Terminating (Error String (Store Text Val))
run ss = fmap fst <$> runFix (runInterp ?bound (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
run ss = fmap fst <$> runLeastFixPoint (runInterp ?bound (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
instance ArrowChoice c => IsVal Val (Interp c) where
boolLit = arr $ \(b,_) -> case b of
......
......@@ -36,7 +36,7 @@ import Control.Arrow.Fail
import Control.Arrow.Fix
import Control.Arrow.Store
import Control.Arrow.Transformer.Abstract.Except
import Control.Arrow.Transformer.Abstract.Fix
import Control.Arrow.Transformer.Abstract.LeastFixPoint
import Control.Arrow.Transformer.Abstract.Store
import Control.Monad.State
......@@ -51,7 +51,7 @@ runInterp :: Interp c x y -> c (Store Text Val,x) (Error String (Store Text Val,
runInterp (Interp f) = runExcept (runStore f)
run :: [State Label Statement] -> Terminating (Error String (Store Text Val))
run ss = fmap fst <$> runFix (runInterp (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
run ss = fmap fst <$> runLeastFixPoint (runInterp (Shared.run :: Fix [Statement] () (Interp (~>)) [Statement] ())) (S.empty,generate (sequence ss))
instance ArrowChoice c => IsVal Val (Interp c) where
boolLit = arr $ \(b,l) -> Val (BoolLit b l)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment