{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Symantic for 'Foldable'. module Language.Symantic.Compiling.Foldable where import Data.Foldable (Foldable) import qualified Data.Foldable as Foldable import Control.Monad (liftM, liftM2, liftM3) import Data.Proxy import Data.String (IsString) import Data.Text (Text) import Data.Type.Equality ((:~:)(Refl)) import Prelude hiding (Foldable(..) , all, and, any, concat, concatMap , mapM_, notElem, or, sequence, sequence_) import Language.Symantic.Typing import Language.Symantic.Compiling.Term import Language.Symantic.Compiling.Bool (tyBool) import Language.Symantic.Compiling.Eq (tyEq) import Language.Symantic.Compiling.List (tyList) import Language.Symantic.Compiling.Monoid (tyMonoid) import Language.Symantic.Compiling.Num (tyNum) import Language.Symantic.Compiling.Ord (tyOrd) import Language.Symantic.Interpreting import Language.Symantic.Transforming.Trans -- * Class 'Sym_Foldable' class Sym_Foldable term where foldMap :: (Foldable f, Monoid m) => term (a -> m) -> term (f a) -> term m foldr :: Foldable f => term (a -> b -> b) -> term b -> term (f a) -> term b foldr' :: Foldable f => term (a -> b -> b) -> term b -> term (f a) -> term b foldl :: Foldable f => term (b -> a -> b) -> term b -> term (f a) -> term b foldl' :: Foldable f => term (b -> a -> b) -> term b -> term (f a) -> term b length :: Foldable f => term (f a) -> term Int null :: Foldable f => term (f a) -> term Bool minimum :: (Foldable f, Ord a) => term (f a) -> term a maximum :: (Foldable f, Ord a) => term (f a) -> term a elem :: (Foldable f, Eq a) => term a -> term (f a) -> term Bool sum :: (Foldable f, Num a) => term (f a) -> term a product :: (Foldable f, Num a) => term (f a) -> term a toList :: Foldable f => term (f a) -> term [a] all :: Foldable f => term (a -> Bool) -> term (f a) -> term Bool and :: Foldable f => term (f Bool) -> term Bool any :: Foldable f => term (a -> Bool) -> term (f a) -> term Bool concat :: Foldable f => term (f [a]) -> term [a] concatMap :: Foldable f => term (a -> [b]) -> term (f a) -> term [b] find :: Foldable f => term (a -> Bool) -> term (f a) -> term (Maybe a) foldlM :: (Foldable f, Monad m) => term (b -> a -> m b) -> term b -> term (f a) -> term (m b) foldrM :: (Foldable f, Monad m) => term (a -> b -> m b) -> term b -> term (f a) -> term (m b) forM_ :: (Foldable f, Monad m) => term (f a) -> term (a -> m b) -> term (m ()) for_ :: (Foldable f, Applicative p) => term (f a) -> term (a -> p b) -> term (p ()) mapM_ :: (Foldable f, Monad m) => term (a -> m b) -> term (f a) -> term (m ()) maximumBy :: Foldable f => term (a -> a -> Ordering) -> term (f a) -> term a minimumBy :: Foldable f => term (a -> a -> Ordering) -> term (f a) -> term a notElem :: (Foldable f, Eq a) => term a -> term (f a) -> term Bool or :: Foldable f => term (f Bool) -> term Bool sequenceA_ :: (Foldable f, Applicative p) => term (f (p a)) -> term (p ()) sequence_ :: (Foldable f, Monad m) => term (f (m a)) -> term (m ()) traverse_ :: (Foldable f, Applicative p) => term (a -> p b) -> term (f a) -> term (p ()) -- asum :: (Foldable t, GHC.Base.Alternative f) => t (f a) -> f a -- msum :: (Foldable t, GHC.Base.MonadPlus m) => t (m a) -> m a default foldMap :: (Trans t term, Foldable f, Monoid m) => t term (a -> m) -> t term (f a) -> t term m default foldr :: (Trans t term, Foldable f) => t term (a -> b -> b) -> t term b -> t term (f a) -> t term b default foldr' :: (Trans t term, Foldable f) => t term (a -> b -> b) -> t term b -> t term (f a) -> t term b default foldl :: (Trans t term, Foldable f) => t term (b -> a -> b) -> t term b -> t term (f a) -> t term b default foldl' :: (Trans t term, Foldable f) => t term (b -> a -> b) -> t term b -> t term (f a) -> t term b default length :: (Trans t term, Foldable f) => t term (f a) -> t term Int default null :: (Trans t term, Foldable f) => t term (f a) -> t term Bool default minimum :: (Trans t term, Foldable f, Ord a) => t term (f a) -> t term a default maximum :: (Trans t term, Foldable f, Ord a) => t term (f a) -> t term a default elem :: (Trans t term, Foldable f, Eq a) => t term a -> t term (f a) -> t term Bool default sum :: (Trans t term, Foldable f, Num a) => t term (f a) -> t term a default product :: (Trans t term, Foldable f, Num a) => t term (f a) -> t term a default toList :: (Trans t term, Foldable f) => t term (f a) -> t term [a] default all :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term Bool default and :: (Trans t term, Foldable f) => t term (f Bool) -> t term Bool default any :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term Bool default concat :: (Trans t term, Foldable f) => t term (f [a]) -> t term [a] default concatMap :: (Trans t term, Foldable f) => t term (a -> [b]) -> t term (f a) -> t term [b] default find :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term (Maybe a) default foldlM :: (Trans t term, Foldable f, Monad m) => t term (b -> a -> m b) -> t term b -> t term (f a) -> t term (m b) default foldrM :: (Trans t term, Foldable f, Monad m) => t term (a -> b -> m b) -> t term b -> t term (f a) -> t term (m b) default forM_ :: (Trans t term, Foldable f, Monad m) => t term (f a) -> t term (a -> m b) -> t term (m ()) default for_ :: (Trans t term, Foldable f, Applicative p) => t term (f a) -> t term (a -> p b) -> t term (p ()) default mapM_ :: (Trans t term, Foldable f, Monad m) => t term (a -> m b) -> t term (f a) -> t term (m ()) default maximumBy :: (Trans t term, Foldable f) => t term (a -> a -> Ordering) -> t term (f a) -> t term a default minimumBy :: (Trans t term, Foldable f) => t term (a -> a -> Ordering) -> t term (f a) -> t term a default notElem :: (Trans t term, Foldable f, Eq a) => t term a -> t term (f a) -> t term Bool default or :: (Trans t term, Foldable f) => t term (f Bool) -> t term Bool default sequenceA_ :: (Trans t term, Foldable f, Applicative p) => t term (f (p a)) -> t term (p ()) default sequence_ :: (Trans t term, Foldable f, Monad m) => t term (f (m a)) -> t term (m ()) default traverse_ :: (Trans t term, Foldable f, Applicative p) => t term (a -> p b) -> t term (f a) -> t term (p ()) foldMap = trans_map2 foldMap foldr = trans_map3 foldr foldr' = trans_map3 foldr' foldl = trans_map3 foldl foldl' = trans_map3 foldl' length = trans_map1 length null = trans_map1 null minimum = trans_map1 minimum maximum = trans_map1 maximum elem = trans_map2 elem sum = trans_map1 sum product = trans_map1 product toList = trans_map1 toList all = trans_map2 all and = trans_map1 and any = trans_map2 any concat = trans_map1 concat concatMap = trans_map2 concatMap find = trans_map2 find foldlM = trans_map3 foldlM foldrM = trans_map3 foldrM forM_ = trans_map2 forM_ for_ = trans_map2 for_ mapM_ = trans_map2 mapM_ maximumBy = trans_map2 maximumBy minimumBy = trans_map2 minimumBy notElem = trans_map2 notElem or = trans_map1 or sequenceA_ = trans_map1 sequenceA_ sequence_ = trans_map1 sequence_ traverse_ = trans_map2 traverse_ type instance Sym_of_Iface (Proxy Foldable) = Sym_Foldable type instance Consts_of_Iface (Proxy Foldable) = Proxy Foldable ': Consts_imported_by Foldable type instance Consts_imported_by Foldable = '[] instance Sym_Foldable HostI where foldMap = liftM2 Foldable.foldMap foldr = liftM3 Foldable.foldr foldr' = liftM3 Foldable.foldr' foldl = liftM3 Foldable.foldl foldl' = liftM3 Foldable.foldl' null = liftM Foldable.null length = liftM Foldable.length minimum = liftM Foldable.minimum maximum = liftM Foldable.maximum elem = liftM2 Foldable.elem sum = liftM Foldable.sum product = liftM Foldable.product toList = liftM Foldable.toList all = liftM2 Foldable.all and = liftM Foldable.and any = liftM2 Foldable.any concat = liftM Foldable.concat concatMap = liftM2 Foldable.concatMap find = liftM2 Foldable.find foldlM = liftM3 Foldable.foldlM foldrM = liftM3 Foldable.foldrM forM_ = liftM2 Foldable.forM_ for_ = liftM2 Foldable.for_ mapM_ = liftM2 Foldable.mapM_ maximumBy = liftM2 Foldable.maximumBy minimumBy = liftM2 Foldable.minimumBy notElem = liftM2 Foldable.notElem or = liftM Foldable.or sequenceA_ = liftM Foldable.sequenceA_ sequence_ = liftM Foldable.sequence_ traverse_ = liftM2 Foldable.traverse_ instance Sym_Foldable TextI where foldMap = textI_app2 "foldMap" foldr = textI_app3 "foldr" foldr' = textI_app3 "foldr'" foldl = textI_app3 "foldl" foldl' = textI_app3 "foldl'" null = textI_app1 "null" length = textI_app1 "length" minimum = textI_app1 "minimum" maximum = textI_app1 "maximum" elem = textI_app2 "elem" sum = textI_app1 "sum" product = textI_app1 "product" toList = textI_app1 "toList" all = textI_app2 "all" and = textI_app1 "and" any = textI_app2 "any" concat = textI_app1 "concat" concatMap = textI_app2 "concatMap" find = textI_app2 "find" foldlM = textI_app3 "foldlM" foldrM = textI_app3 "foldrM" forM_ = textI_app2 "forM_" for_ = textI_app2 "for_" mapM_ = textI_app2 "mapM_" maximumBy = textI_app2 "maximumBy" minimumBy = textI_app2 "minimumBy" notElem = textI_app2 "notElem" or = textI_app1 "or" sequenceA_ = textI_app1 "sequenceA_" sequence_ = textI_app1 "sequence_" traverse_ = textI_app2 "traverse_" instance (Sym_Foldable r1, Sym_Foldable r2) => Sym_Foldable (DupI r1 r2) where foldMap = dupI2 sym_Foldable foldMap foldr = dupI3 sym_Foldable foldr foldr' = dupI3 sym_Foldable foldr' foldl = dupI3 sym_Foldable foldl foldl' = dupI3 sym_Foldable foldl' null = dupI1 sym_Foldable null length = dupI1 sym_Foldable length minimum = dupI1 sym_Foldable minimum maximum = dupI1 sym_Foldable maximum elem = dupI2 sym_Foldable elem sum = dupI1 sym_Foldable sum product = dupI1 sym_Foldable product toList = dupI1 sym_Foldable toList all = dupI2 sym_Foldable all and = dupI1 sym_Foldable and any = dupI2 sym_Foldable any concat = dupI1 sym_Foldable concat concatMap = dupI2 sym_Foldable concatMap find = dupI2 sym_Foldable find foldlM = dupI3 sym_Foldable foldlM foldrM = dupI3 sym_Foldable foldrM forM_ = dupI2 sym_Foldable forM_ for_ = dupI2 sym_Foldable for_ mapM_ = dupI2 sym_Foldable mapM_ maximumBy = dupI2 sym_Foldable maximumBy minimumBy = dupI2 sym_Foldable minimumBy notElem = dupI2 sym_Foldable notElem or = dupI1 sym_Foldable or sequenceA_ = dupI1 sym_Foldable sequenceA_ sequence_ = dupI1 sym_Foldable sequence_ traverse_ = dupI2 sym_Foldable traverse_ instance Const_from Text cs => Const_from Text (Proxy Foldable ': cs) where const_from "Foldable" k = k (ConstZ kind) const_from s k = const_from s $ k . ConstS instance Show_Const cs => Show_Const (Proxy Foldable ': cs) where show_const ConstZ{} = "Foldable" show_const (ConstS c) = show_const c instance -- Proj_ConC Proj_ConC cs (Proxy Foldable) instance -- Term_fromI ( AST ast , Lexem ast ~ LamVarName , Inj_Const (Consts_of_Ifaces is) Foldable , Inj_Const (Consts_of_Ifaces is) Monoid , Inj_Const (Consts_of_Ifaces is) (->) , Inj_Const (Consts_of_Ifaces is) Int , Inj_Const (Consts_of_Ifaces is) Bool , Inj_Const (Consts_of_Ifaces is) Eq , Inj_Const (Consts_of_Ifaces is) Ord , Inj_Const (Consts_of_Ifaces is) Num , Inj_Const (Consts_of_Ifaces is) [] , Proj_Con (Consts_of_Ifaces is) , Term_from is ast ) => Term_fromI is (Proxy Foldable) ast where term_fromI :: forall ctx ls rs ret. Term_fromIT ast ctx ret is ls (Proxy Foldable ': rs) term_fromI ast ctx k = case ast_lexem ast of "foldMap" -> foldMap_from "foldr" -> foldr_from foldr "foldr'" -> foldr_from foldr' "foldl" -> foldl_from foldl "foldl'" -> foldl_from foldl' "length" -> ta2ty_from length "null" -> ta2ty_from null "minimum" -> ta2a_from tyOrd minimum "maximum" -> ta2a_from tyOrd maximum "sum" -> ta2a_from tyNum sum "product" -> ta2a_from tyNum product "elem" -> elem_from "all" -> allany_from all "any" -> allany_from any "and" -> andor_from and "or" -> andor_from or "toList" -> toList_from "concat" -> concat_from _ -> Left $ Error_Term_unsupported where foldMap_from = -- foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m from_ast2 ast $ \ast_a2m ast_ta as -> term_from ast_a2m ctx $ \ty_a2m (TermLC a2m) -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_type2 tyFun ast_a2m ty_a2m $ \Refl ty_a2m_a ty_a2m_m -> check_constraint (At (Just ast_a2m) (tyMonoid :$ ty_a2m_m)) $ \Con -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_type (At (Just ast_a2m) ty_a2m_a) (At (Just ast_ta) ty_ta_a) $ \Refl -> k as ty_a2m_m $ TermLC $ \c -> foldMap (a2m c) (ta c) foldr_from (fold::forall term f a b. (Sym_Foldable term, Foldable f) => term (a -> b -> b) -> term b -> term (f a) -> term b) = -- foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b from_ast3 ast $ \ast_a2b2b ast_b ast_ta as -> term_from ast_a2b2b ctx $ \ty_a2b2b (TermLC a2b2b) -> term_from ast_b ctx $ \ty_b (TermLC b) -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_type2 tyFun ast_a2b2b ty_a2b2b $ \Refl ty_a2b2b_a ty_a2b2b_b2b -> check_type2 tyFun ast_a2b2b ty_a2b2b_b2b $ \Refl ty_a2b2b_b2b_b0 ty_a2b2b_b2b_b1 -> check_type (At (Just ast_a2b2b) ty_a2b2b_b2b_b0) (At (Just ast_a2b2b) ty_a2b2b_b2b_b1) $ \Refl -> check_type (At (Just ast_a2b2b) ty_a2b2b_b2b_b0) (At (Just ast_b) ty_b) $ \Refl -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_type (At (Just ast_a2b2b) ty_a2b2b_a) (At (Just ast_ta) ty_ta_a) $ \Refl -> k as ty_b $ TermLC $ \c -> fold (a2b2b c) (b c) (ta c) foldl_from (fold::forall term f a b. (Sym_Foldable term, Foldable f) => term (b -> a -> b) -> term b -> term (f a) -> term b) = -- foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b from_ast3 ast $ \ast_b2a2b ast_b ast_ta as -> term_from ast_b2a2b ctx $ \ty_b2a2b (TermLC b2a2b) -> term_from ast_b ctx $ \ty_b (TermLC b) -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_type2 tyFun ast_b2a2b ty_b2a2b $ \Refl ty_b2a2b_b ty_b2a2b_a2b -> check_type2 tyFun ast_b2a2b ty_b2a2b_a2b $ \Refl ty_b2a2b_a2b_a ty_b2a2b_a2b_b -> check_type (At (Just ast_b2a2b) ty_b2a2b_b) (At (Just ast_b2a2b) ty_b2a2b_a2b_b) $ \Refl -> check_type (At (Just ast_b2a2b) ty_b2a2b_b) (At (Just ast_b) ty_b) $ \Refl -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_type (At (Just ast_b2a2b) ty_b2a2b_a2b_a) (At (Just ast_ta) ty_ta_a) $ \Refl -> k as ty_b $ TermLC $ \c -> fold (b2a2b c) (b c) (ta c) ta2ty_from :: forall ty. Inj_Const (Consts_of_Ifaces is) ty => (forall term t a. (Sym_Foldable term, Foldable t) => term (t a) -> term ty) -> Either (Error_Term is ast) ret ta2ty_from f = -- length :: Foldable t => t a -> Int -- null :: Foldable t => t a -> Bool from_ast1 ast $ \ast_ta as -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t _ty_ta_a -> k as (TyConst inj_const::Type (Consts_of_Ifaces is) ty) $ TermLC $ \c -> f (ta c) ta2a_from :: forall con. Type (Consts_of_Ifaces is) con -> (forall term t a. (Sym_Foldable term, Foldable t, con a) => term (t a) -> term a) -> Either (Error_Term is ast) ret ta2a_from q f = -- minimum :: (Foldable t, Ord a) => t a -> a -- maximum :: (Foldable t, Ord a) => t a -> a -- sum :: (Foldable t, Num a) => t a -> a -- product :: (Foldable t, Num a) => t a -> a from_ast1 ast $ \ast_ta as -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_constraint (At (Just ast_ta) (q :$ ty_ta_a)) $ \Con -> k as ty_ta_a $ TermLC $ \c -> f (ta c) elem_from = -- elem :: (Foldable t, Eq a) => a -> t a -> Bool from_ast2 ast $ \ast_a ast_ta as -> term_from ast_a ctx $ \ty_a (TermLC a) -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_constraint (At (Just ast_ta) (tyEq :$ ty_ta_a)) $ \Con -> check_type (At (Just ast_a) ty_a) (At (Just ast_ta) ty_ta_a) $ \Refl -> k as tyBool $ TermLC $ \c -> a c `elem` ta c allany_from (g::forall term f a. (Sym_Foldable term, Foldable f) => term (a -> Bool) -> term (f a) -> term Bool) = -- all :: Foldable t => (a -> Bool) -> t a -> Bool -- any :: Foldable t => (a -> Bool) -> t a -> Bool from_ast2 ast $ \ast_a2Bool ast_ta as -> term_from ast_a2Bool ctx $ \ty_a2Bool (TermLC a2Bool) -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_type2 tyFun ast_a2Bool ty_a2Bool $ \Refl ty_a2Bool_a ty_a2Bool_Bool -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> check_type (At (Just ast_a2Bool) ty_a2Bool_a) (At (Just ast_ta) ty_ta_a) $ \Refl -> check_type (At Nothing tyBool) (At (Just ast_a2Bool) ty_a2Bool_Bool) $ \Refl -> k as tyBool $ TermLC $ \c -> g (a2Bool c) (ta c) andor_from (g::forall term f. (Sym_Foldable term, Foldable f) => term (f Bool) -> term Bool) = -- and :: Foldable t => t Bool -> Bool -- or :: Foldable t => t Bool -> Bool from_ast1 ast $ \ast_tBool as -> term_from ast_tBool ctx $ \ty_tBool (TermLC tBool) -> check_constraint1 tyFoldable ast_tBool ty_tBool $ \Refl Con _ty_tBool_t ty_tBool_Bool -> check_type (At Nothing tyBool) (At (Just ast_tBool) ty_tBool_Bool) $ \Refl -> k as tyBool $ TermLC $ \c -> g (tBool c) toList_from = -- toList :: Foldable t => t a -> [a] from_ast1 ast $ \ast_ta as -> term_from ast_ta ctx $ \ty_ta (TermLC ta) -> check_constraint1 tyFoldable ast_ta ty_ta $ \Refl Con _ty_ta_t ty_ta_a -> k as (tyList :$ ty_ta_a) $ TermLC $ \c -> toList (ta c) concat_from = -- concat :: Foldable t => t [a] -> [a] from_ast1 ast $ \ast_tla as -> term_from ast_tla ctx $ \ty_tla (TermLC tla) -> check_constraint1 tyFoldable ast_tla ty_tla $ \Refl Con _ty_tla_t ty_tla_la -> check_type1 tyList ast_tla ty_tla_la $ \Refl ty_tla_la_a -> k as (tyList :$ ty_tla_la_a) $ TermLC $ \c -> concat (tla c) -- | The 'Foldable' 'Type' tyFoldable :: Inj_Const cs Foldable => Type cs Foldable tyFoldable = TyConst inj_const sym_Foldable :: Proxy Sym_Foldable sym_Foldable = Proxy syFoldable :: IsString a => [Syntax a] -> Syntax a syFoldable = Syntax "Foldable"