github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00
Code Issues Projects Releases Wiki Activity

Turn the wheel to maximum fastness.

Browse Source
This commit is contained in:
Rob Rix 2019-06-28 13:15:05 -04:00
parent bc2c536822
commit 30873a7762
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
semantic-core/src/Data/Core.hs
View File

@ -255,14 +255,14 @@ efold :: forall l m n z b
-> Core (l b)
-> n (z b)
efold var let' seq' lam app unit bool if' string load edge frame dot assign ann k = eiter var alg
where alg :: forall x l' c z' . Functor c => (forall l'' z'' x . (l'' x -> m (z'' x)) -> c (l'' x) -> n (z'' x)) -> (l' x -> m (z' x)) -> CoreF c (l' x) -> n (z' x)
where alg :: forall x l' c z' . (forall a b . Coercible a b => Coercible (c a) (c b)) => (forall l'' z'' x . (l'' x -> m (z'' x)) -> c (l'' x) -> n (z'' x)) -> (l' x -> m (z' x)) -> CoreF c (l' x) -> n (z' x)
alg go h = \case
LetF a -> let' a
a :>>$ b -> go h a `seq'` go h b
LamF b -> lam (coerce (go
(coerce (k . fmap (go h))
:: ((Incr :.: c :.: l') x -> m ((Incr :.: n :.: z') x)))
(fmap coerce b))) -- FIXME: can we avoid this fmap and just coerce harder?
(coerce b)))
a :$$ b -> go h a `app` go h b
UnitF -> unit
BoolF b -> bool b
@ -278,7 +278,7 @@ efold var let' seq' lam app unit bool if' string load edge frame dot assign ann
-- | Efficient Mendler-style iteration.
eiter :: forall l m n z b
. (forall a . m a -> n a)
-> (forall a l' c z' . Functor c => (forall l'' z'' x . (l'' x -> m (z'' x)) -> c (l'' x) -> n (z'' x)) -> (l' a -> m (z' a)) -> CoreF c (l' a) -> n (z' a))
-> (forall a l' c z' . (forall a b . Coercible a b => Coercible (c a) (c b)) => (forall l'' z'' x . (l'' x -> m (z'' x)) -> c (l'' x) -> n (z'' x)) -> (l' a -> m (z' a)) -> CoreF c (l' a) -> n (z' a))
-> (l b -> m (z b))
-> Core (l b)
-> n (z b)