Commit 5f4e35c8 authored by Jente Hidskes's avatar Jente Hidskes

Re-add Stratego ArrowFix definition

parent f973c188
......@@ -7,3 +7,5 @@ import Control.Arrow
class Arrow c => ArrowFix x y c | y -> c, x -> c where
fixA :: (c x y -> c x y) -> c x y
class Arrow c => ArrowFix' c y | c -> y where
fixA' :: ((z -> c x y) -> (z -> c x y)) -> (z -> c x y)
......@@ -73,8 +73,8 @@ eval = runInterp . eval'
liftK :: (a -> _ b) -> Interp a b
liftK f = Interp (Kleisli f)
instance ArrowFix Interp Term where
fixA f = f (fixA f)
instance ArrowFix' Interp Term where
fixA' f = f (fixA' f)
instance ArrowFail () Interp where
failA = Interp failA
......
......@@ -29,11 +29,11 @@ import Data.Hashable
import Text.Printf
-- Shared interpreter for Stratego
eval' :: (ArrowChoice c, ArrowTry c, ArrowPlus c, ArrowApply c, ArrowFix c t,
eval' :: (ArrowChoice c, ArrowTry c, ArrowPlus c, ArrowApply c, ArrowFix' c t,
ArrowFail () c, ArrowDeduplicate c, Eq t, Hashable t,
HasStratEnv c, IsTerm t c, IsTermEnv env t c)
=> (Strat -> c t t)
eval' = fixA $ \ev s0 -> dedupA $ case s0 of
eval' = fixA' $ \ev s0 -> dedupA $ case s0 of
Id -> id
S.Fail -> failA'
Seq s1 s2 -> sequence (ev s1) (ev s2)
......
......@@ -189,12 +189,12 @@ instance IsTerm Term Interp where
instance UpperBounded (Interp () Term) where
top = proc () -> success failA' -< Wildcard
instance ArrowFix Interp Term where
fixA f z = proc x -> do
instance ArrowFix' Interp Term where
fixA' f z = proc x -> do
i <- getFuel -< ()
if i <= 0
then top -< ()
else localFuel (f (fixA f) z) -< (i-1,x)
else localFuel (f (fixA' f) z) -< (i-1,x)
where
getFuel = liftK (const (snd <$> ask))
localFuel (Interp (Kleisli g)) = liftK $ \(i,a) -> local (second (const i)) (g a)
......
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