Metaprogramming in Haskell

Table of Contents Template Haskell Generic Programming in Haskell (Type-level Programming)

HOC - Haskell Objective-C binding Class/Instance jmacro JavaScript HAppS lambdabot IRC Bot (IRC )

TH ( ) Template Haskell Q IO compile-time wxWidgets, Socket, etc...

TH Features {-# LANGUAGE TemplateHaskell, QuasiQuotes #-} import Language.Haskell.TH splice reify / runIO

2 RandomDef.hs {-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.TH import System.Random $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " `) " |]) [] (´ return (t:m) )

(RandomDef.hs) {-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.TH import System.Random $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " `) " |]) [] (´ return (t:m) )

Template Haskell Exp Dec Pat Type

Template Haskell Exp Dec Pat Type ……(cf. HOC)

Template Haskell Exp Dec Pat Type ……(cf. HOC) Q

putStrLn “Hello!” = AppE (VarE ‘putStrLn) (LitE (stringL “Hello!”)) main :: IO () main = getLine >>= putStrLn [ SigD (mkName "main") (AppT (VarT ''IO) (VarT ''())), FunD (mkName "main") [Clause [] (NormalB $ InﬁxE (Just $ VarE 'getLine) (VarE '(>>=)) (Just $ VarE 'putStrLn) ) []]]

lib2 = let l=LetS[ValD(VarP $ mkName"it")(NormalB(f"be"))[]] f=VarE . mkName in DoE [ l, l, l, NoBindS $ f"oh",l, NoBindS $ InﬁxE(Just$ f"speaking")(f"words")(Just $ f "wisdom"),l]

lib2 = let l=LetS[ValD(VarP $ mkName"it")(NormalB(f"be"))[]] f=VarE . mkName in DoE [ l, l, l, NoBindS $ f"oh",l, NoBindS $ InﬁxE(Just$ f"speaking")(f"words")(Just $ f "wisdom"),l] do let it = be let it = be let it = be oh let it = be speaking `words` wisdom let it = be

k GHCi GHCi> runQ [d| data List a = Cons a (List a) | Nil |] [DataD [] List [PlainTV a_0] [NormalC Cons [(NotStrict,VarT a_0), (NotStrict,AppT (ConT List) (VarT a_0))],NormalC Nil []] []]

[k| |] (“k” ) Q [e| putStrLn “foo” |] (e ) [d| main = putStrLn “:-)” |] [t| Maybe String |] [p| Just 2 |] (GHC HEAD) ( ) `a, ``Maybe ( )

{-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.TH import System.Random $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " ( ´ `) " |]) [] return (t:m) )

(RandomDef.hs) {-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.TH import System.Random + $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " ( ´ `) " |]) [] return (t:m) )

(Splice) Q $( ) main = $(1 + ‘a) :: $(myType)

(Splice) Q $( ) main = $(1 + ‘a) :: $(myType) $() (6.12 )

(Splice) Q $( ) main = $(1 + ‘a) :: $(myType) $() (6.12 ) Splice (6.12 )

(Splice) Q $( ) main = $(1 + ‘a) :: $(myType) $() (6.12 ) Splice (6.12 ) Splice import

Q Monad IO runIO $ ... (reify)

Q Monad IO runIO $ ... (reify) Q

Q Monad IO runIO $ ... (reify) Q GHCi runQ $ reify ''Maybe

IO {-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.THIO Get import System.Random $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " `) " |]) [] (´ return (t:m) )

{-# LANGUAGE TemplateHaskell #-} module Main where import Language.Haskell.TH import System.Random $( do rnd ← runIO $ randomRIO (0,1) let nm = mkName (["a", "b"] !! rnd) m ← [d| main = $(varE $ mkName "a") |] t ← valD (varP nm) (normalB [| putStrLn " `) " |]) [] (´ return (t:m) )

reify compile-time ( ) derive DEMO

LISP EDSL GHC HEAD [$ident| ... |]

LISP EDSL GHC HEAD [$ident| ... |] ident QuasiQuoter

LISP EDSL GHC HEAD [$ident| ... |] ident QuasiQuoter String → ExpQ String → PatQ

LISP EDSL GHC HEAD [$ident| ... |] ident QuasiQuoter String → ExpQ String → PatQ Graph JSON

mkTweet :: Int → String → JSValue → JSValue mkTweet tid text = [$json| {“status”: { “id”: #int<tid>, “text”: #str<text> }} |] getID :: JSValue → Int getID [$json| “id”:#Int{var} |] = var

mkTweet :: Int → String → JSValue → JSValue mkTweet tid text = [$json| {“status”: { “id”: #int<tid>, “text”: #str<text> }} |] getID :: JSValue → Int getID [$json| “id”:#Int{var} |] = var ( )

JSON data JSON = JSNumber Int | JSString String | ... | Var String deriving (Show, Eq, Ord) -- QuasiQuoter json :: QuasiQuoter json = QuasiQuoter quoteJSONExp quoteJSONPat quoteJSONExp :: String → ExpQ quoteJSONPat :: String → PatQ quoteJSONPat src = ... quoteJSONExp src = ...

dataToExpQ, dataToPatQ jsonPat src= dataToPatQ (const Nothing `extQ` antiQuoteP) (parseJSON src) antiQuoteP (Var a) = Just (varP (mkName a)) antiQuoteP _ = Nothing

data JSON = JSNumber Int | JSString String | ... | Var String deriving (Show, Eq, Ord, Data, Typeable) ... parseExpr = ... -- Parser quoteJSONPat src = do let exp = parseExpr src dataToPatQ (const Nothing `extQ` antiStrPat) exp antiStrPat :: Expr → Maybe PatQ antiStrPat (Var a) = Just $ varP (mkName a) antiStrPat _ = Nothing

data JSON = JSNumber Int | JSString String | ... | Var String deriving (Show, Eq, Ord, Data, Typeable) ... parseExpr = ... -- Parser quoteJSONPat src = do let exp = parseExpr src dataToPatQ (const Nothing `extQ` antiStrPat) exp antiStrPat :: Expr → Maybe PatQ antiStrPat (Var a) = Just $ varP (mkName a) antiStrPat _ = Nothing Var

…… dataToExpQ extQ …… ……

Generic Programming in Haskell Template Haskell Generic Programming in Haskell (Type-level Programming)

Generic Programming in Haskell (Generics ; GHC ) SYB (Scrap Your Boilerplate) Instant Generics

Sum of Product ( ) {-# LANGUAGE Generics, TypeOperators #-}

Sum of Product ( ) {-# LANGUAGE Generics, TypeOperators #-} import GHC.Generics

data Bool = False | True = Unit :+: Unit data Maybe a = Nothing | Just a = Unit :+: a Just 12 = Inr 12, Nothing = Inl Unit data List a = Nil | Cons a (List a) = Unit :+: (a :*: (List a)) [1,2,3] = Inr (1 :*: Inr (2 :*: Inr (3 :*: Inl Unit)))

Binary Encode class Bin a where toBin :: a → [Int] fromBin :: [Int] → (a, [Int]) toBin {| Unit |} Unit = [0] toBin {| p :*: q |} (a :*: b) = toBin a ++ toBin b toBin {| p :+: q |} (Inl a) = 0:toBin a toBin {| p :+: q |} (Inr b) = 1:toBin b fromBin {| Unit |} (0:xs) = (Unit, xs) fromBin {| p :*: q |} bin = let (a, bin') = fromBin bin (b, bin'') = fromBin bin' ...

class Bin a where toBin :: a → [Int] fromBin :: [Int] → (a, [Int]) toBin {| Unit |} Unit = [0] toBin {| p :*: q |} (a :*: b) = toBin a ++ toBin b toBin {| p :+: q |} (Inl a) = 0:toBin a toBin {| p :+: q |} (Inr b) = 1:toBin b fromBin {| Unit |} (0:xs) = (Unit, xs) fromBin {| p :*: q |} bin = let (a, bin') = fromBin bin (b, bin'') = fromBin bin' in ...

class Bin a where toBin :: a → [Int] fromBin :: [Int] → (a, [Int]) toBin {| Unit |} Unit = [0] toBin {| p :*: q |} (a :*: b) = toBin a ++ toBin b toBin {| p :+: q |} (Inl a) = 0:toBin a toBin {| p :+: q |} (Inr b) = 1:toBin b fromBin {| Unit |} (0:xs) = (Unit, xs) fromBin {| p :*: q |} bin = let (a, bin') = fromBin bin (b, bin'') = fromBin bin' in (a :*: b, bin’’) ...

( Int, Char) instance instance Bin Int where toBin = .... instance Bin Char where toBin = ... instance Bin a Bin [a] instance (Bin a, Bin b) Bin (a, b) instance Bin a Bin (Maybe a) instance (Bin a, Bin b) Bin (Either a b)

Scrap Your Boilerplate syb Haskell dataToExpQ

Typeable / Data Typeable: cast ( )

Typeable / Data Typeable: cast ( ) Data: (gfoldl) cast

Typeable / Data GHC {-# LANGUAGE DeriveDataTypeable #-} data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving (Data, Typeable) Standalone deriving {-# LANGUAGE StandaloneDeriving #-} deriving instance Typeable1 Tree deriving instance Data a Data (Tree a)

-- data Expr = Num Int | Var String | Plus Expr Expr | Minus Expr Expr | Multi Expr Expr | Div Expr Expr deriving (Show, Eq, Data, Typeable) normalize :: Expr → Expr normalize = everywhere (mkT normalize') normalize' (Plus (Num n) (Num m)) = Num (n + m) normalize' (Multi (Num n) (Num m)) = Num (n * m) normalize' (Minus (Num n) (Num m)) = Num (n - m) normalize' (Div (Num n) (Num m)) = Num (n `div` m) normalize' x =x

SYB mkT :: (b → b) → (a → a)

SYB mkT :: (b → b) → (a → a) everywhere :: GenericT → GenericT

SYB mkT :: (b → b) → (a → a) everywhere :: GenericT → GenericT bottom-up

SYB mkT :: (b → b) → (a → a) everywhere :: GenericT → GenericT bottom-up top-down everywhere'

(1) GenericT = ∀a. a → a Transformer mkT fun trans `extT` fun GenericM = ∀a. a → m a : GenericQ = ∀a. a → r Query ( ) `mkQ` fun query `extQ` fun

(2) GenericB = ∀a. a Builder builder `extB` fun GenericR = ∀a. m a Reader mkR fun reader `extR` fun

gmapT :: GenericT → a → a somewhere :: GenericM m → GenecirM m everything :: (r → r → r) → GenericQ r → GenericQ r listify :: (r → Bool) → GenericQ [r] gsize/glength :: GenericQ Int

dataToExpQ dataToExpQ :: Data a GenericQ (Maybe ExpQ) → a → ExpQ (const Nohting `ext` anti)

Instant Generics (Type families) DPH (Data Parallel Haskell)

IG Representable a type Rep a data U = U data a :+: b = L a | R b ( ) data a :*: b = a :*: b data C con a = C a data Var p = Var p data Rec p = Rec p

Int, Bool Int, Bool data Maybe a = Nothing | Just a type Rep (Maybe a) = C Maybe_Nothing_ U :+: C Maybe_Just_ (Var a) Just 12 = R(C(Var 12)), Nothing = L(C U)

1 Binary Encode class Bin a where toBin :: a → [Int] fromBin :: [Int] → (a, [Int]) C, Var, Rec instance Bin U where toBin U = [] fromBin xs = (U, []) instance (Bin a, Bin b) Bin (a :+: b) where toBin (L a) = 0:toBin a toBin (R b) = 1:toBin b fromBin (0:bin) = ... ... instance (Bin a, Bin b) Bin (a :*: b) where toBin (a :*: b) = toBin a ++ toBin b fromBin bin = ... instance Bin Int where ...

def_toBin :: (Representable a, Bin (Rep a)) a → [Int] def_toBin = toBin . from ... instance Bin a Bin [a] where toBin = def_toBin; fromBin = def_fromBin

2 ! class Normalize a where normalize :: a → a instance Normalize U instance Normalize (Var a) ... instance Normalize a Normalize (Rec a) where normalize (Rec a) = Rec (normalize a)

Expr dft_normalize :: (Representable a, Normalize (Rep a)) a→a dft_normalize = to . normalize . from instance Normalize Expr where normalize x = case dft_normalize x of Plus (Num n) (Num m) → Num (n + m) Multi (Num n) (Num m) → Num (n * m) Minus (Num n) (Num m) → Num (n - m) Div (Num n) (Num m) → Num (n `div` m) x →x Var Int, Char

100000(ms) 10000(ms) 1000(ms) 100(ms) 10(ms) 1(ms) geq rmWeights selectInt selectIntAcc SYB Instant Generics

100000(ms) 75000(ms) 50000(ms) 25000(ms) 0(ms) geq rmWeights selectInt selectIntAcc SYB Instant Generics

GP SYB with class Data Smash ( ) SYB Uniplate MPTC

Metaprogramming in Haskell

More Related Content

What's hot

Viewers also liked

Similar to Metaprogramming in Haskell

More from Hiromi Ishii

Metaprogramming in Haskell