<commit_before>This is an attempt to intercept and rewrite 'applications'
(that is juxtapositions of expressions) and change the
modus ponens typing rule to something more flexible.

Load this file with
 $ ghci -XTemplateHaskell ApplyRewriter.lhs

And then execute
 > $(dullness [| negate 1 |])



> {-# LANGUAGE TypeFamilies, TemplateHaskell, GADTs, KindSignatures,
>              TypeSynonymInstances, StandaloneDeriving,
>              MultiParamTypeClasses, FlexibleInstances #-}

> import Language.Haskell.TH
> import Control.Category
> import Prelude hiding ((.))
> import qualified Prelude ((.))
> import Language.Haskell.TH.Syntax
> -- import Data.Void

> data Void where

> class Category c => Apply c a b where
>   type Domain c a b :: *
>   type Codomain c a b :: *
>   type Domain c a b = a
>   type Codomain c a b = b
>   (<$>) :: c a b -> Domain c a b -> Codomain c a b
>   cry :: c (a, b) d -> c a (c b d)
>   ucr :: c a (c b d) -> c (a, b) d

> instance Apply (->) a b where
>   (<$>) = ($)
>   cry = curry
>   ucr = uncurry

> dullness :: ExpQ -> Q Exp
> dullness e = e >>= return Prelude.. walkAST

> walkAST :: Exp -> Exp
> walkAST l@(LitE {}) = l
> walkAST v@(VarE {}) = v
> walkAST (AppE f a) = f  -- AppE (AppE (VarE (mkName "<$>")) (walkAST f)) (walkAST a)

Now that we can perform the transformation, it would be interesting
to give a different instance.

> data LC :: * -> * -> * where
>   RAW :: Show a => a -> LC Void a
>   V :: LC Void Int
>   APP :: LC a b -> LC Void a -> LC Void b
>   ID :: LC a a
>   COMP :: LC b c -> LC a b -> LC a c
>   PLUS :: LC (Int, Int) Int
>   PAIR :: LC Void Int -> LC Void Int -> LC Void (Int, Int)
>   CURRY :: LC (a, b) d -> LC a (LC b d)
>   UNCURRY :: LC a (LC b d) -> LC (a, b) d
<commit_msg>start playing around with typed TH<commit_after>This is an attempt to intercept and rewrite 'applications'
(that is juxtapositions of expressions) and change the
modus ponens typing rule to something more flexible.

Load this file with
 $ ghci -XTemplateHaskell ApplyRewriter.lhs

And then execute
 > $$(dullness [|| negate 1 ||])



> {-# LANGUAGE TypeFamilies, TemplateHaskell, GADTs, KindSignatures,
>              TypeSynonymInstances, StandaloneDeriving,
>              MultiParamTypeClasses, FlexibleInstances #-}

> import Language.Haskell.TH
> import Control.Category
> import Prelude hiding ((.))
> import qualified Prelude ((.))
> import Language.Haskell.TH.Syntax
> -- import Data.Void

> data Void where

> class Category c => Apply c a b where
>   type Domain c a b :: *
>   type Codomain c a b :: *
>   type Domain c a b = a
>   type Codomain c a b = b
>   (<$>) :: c a b -> Domain c a b -> Codomain c a b
>   cry :: c (a, b) d -> c a (c b d)
>   ucr :: c a (c b d) -> c (a, b) d

> instance Apply (->) a b where
>   (<$>) = ($)
>   cry = curry
>   ucr = uncurry

> dullness :: Q (TExp a) -> Q (TExp Integer)
> dullness e = e >>= return Prelude.. walkAST Prelude.. unType

> walkAST :: Exp -> TExp Integer
> walkAST l@(LitE {}) = TExp l
> walkAST v@(VarE {}) = TExp v
> walkAST (AppE f a) = TExp f  -- AppE (AppE (VarE (mkName "<$>")) (walkAST f)) (walkAST a)

Now that we can perform the transformation, it would be interesting
to give a different instance.

> data LC :: * -> * -> * where
>   RAW :: Show a => a -> LC Void a
>   V :: LC Void Int
>   APP :: LC a b -> LC Void a -> LC Void b
>   ID :: LC a a
>   COMP :: LC b c -> LC a b -> LC a c
>   PLUS :: LC (Int, Int) Int
>   PAIR :: LC Void Int -> LC Void Int -> LC Void (Int, Int)
>   CURRY :: LC (a, b) d -> LC a (LC b d)
>   UNCURRY :: LC a (LC b d) -> LC (a, b) d

{'fraction_non_alphanumeric': 0.14377085650723026, 'fraction_numerical': 0.0005561735261401557, 'mean_word_length': 2.6741573033707864, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 131, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5736911', 'n_tokens_mistral': 1389, 'n_tokens_neox': 1281, 'n_words': 526}