1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE DataKinds #-}
4 {-# LANGUAGE InstanceSigs #-}
5 {-# LANGUAGE RankNTypes #-}
6 {-# LANGUAGE UndecidableInstances #-}
8 module Symantic.Semantics.ToFer where
10 import Control.Monad (Monad, (>=>))
11 import Data.Function qualified as Fun
12 import Data.Functor (Functor, (<$>))
13 import GHC.Generics (Generic)
15 import Symantic.Syntaxes.Classes
16 import Symantic.Syntaxes.EithersOfTuples
17 import Symantic.Syntaxes.TuplesOfFunctions
19 -- * Type 'TuplesOfFunctions'
21 -- | The 'ToFer' intermediate interpreter
22 -- return Tuples-of-Functions instead of Eithers-of-Tuples.
24 -- In other words, it transforms 'SumFunctor' into functions returning @(sem next)@
25 -- and 'ProductFunctor' into arguments of those functions.
27 -- This is like using an extension parameter introduced in
28 -- https://okmij.org/ftp/typed-formatting/index.html#DSL-FIn
29 -- but here only a single type parameter @(a)@ is exposed
32 -- Useful to avoid declaring and pattern-matching
33 -- an algebraic datatype of type @(a)@,
34 -- as the corresponding function will be called directly,
35 -- given as arguments the terms that would have been
36 -- pattern-matched from a constructor
37 -- of such algebraic datatype.
38 data ToFer sem a = ToFer
39 { tuplesOfFunctions :: forall next. ToF a next -> sem next
40 , eithersOfTuples :: sem a
43 instance (ProductFunctor sem, Monad sem) => ProductFunctor (ToFer sem) where
46 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
47 , eithersOfTuples = eithersOfTuples a <.> eithersOfTuples b
51 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
52 , eithersOfTuples = eithersOfTuples a .> eithersOfTuples b
56 { tuplesOfFunctions = tuplesOfFunctions a >=> tuplesOfFunctions b
57 , eithersOfTuples = eithersOfTuples a <. eithersOfTuples b
59 instance (SumFunctor sem, AlternativeFunctor sem) => SumFunctor (ToFer sem) where
62 { tuplesOfFunctions = \(l, r) -> tuplesOfFunctions a l <|> tuplesOfFunctions b r
63 , eithersOfTuples = eithersOfTuples a <+> eithersOfTuples b
65 instance (Optionable sem, Functor sem) => Optionable (ToFer sem) where
66 optional ma = ToFer{tuplesOfFunctions = (<$> sem), eithersOfTuples = sem}
68 sem = optional (eithersOfTuples ma)
69 instance Functor sem => Dataable (ToFer sem) where
76 ToFer sem (EoT (ADT a)) ->
80 { tuplesOfFunctions = \f -> unToF @(IsToF a) @a f Fun.. adtOfeot <$> eithersOfTuples a
81 , eithersOfTuples = adtOfeot <$> eithersOfTuples a