data Lecture n where

 DSLs :: Lecture 11

Lecture plan

  • GADTs motivation and usage
  • Existential type
  • Rank N types
  • DSL via final tagless

Language for arithmetic

34 + 45 + 26

23 + 45 > 107

(23 + 304 > 107) && (11 > 8 + 5)

Integer literals, add, greater than, logical and:

Let's use Haskell ADT:

data ArithExpr =
    AENum Int
  | AEPlus ArithExpr ArithExpr
  | AEAnd ArithExpr ArithExpr
  | AEGt ArithExpr ArithExpr

-- (23 + 12) > 170 && (35 > 47)
myExpr =
  ((AENum 23 `AEPlus` AENum 12) `AEGt` AENum 170)
  `AEAnd` (AENum 35 `AEGt` AENum 47)

DSL via simple ADT

Do you see any problem?

data ArithExpr =
    AENum Int
  | AEPlus ArithExpr ArithExpr
  | AEAnd ArithExpr ArithExpr
  | AEGt ArithExpr ArithExpr
interpret :: ArithExpr -> Either String (Either Int Bool)
interpret (AENum n) = pure $ Left n
interpret (AEAnd a b) = do
  a' <- interpretBool a
  b' <- interpretBool b
  pure $ Right (a' && b')

interpretBool :: ArithExpr -> Either String Bool
interpretBool x =
  interpret x >>= either (\x -> Left $ "Unexpected " <> show x) pure

Do you see any problem now?

ghci> interpret (AENum 12 `AEAnd` AENum 23)
Left "Unexpected 12"

Are dynamic types unavoidable?

GADTs intuition

ghci> :t AENum
AENum  :: Int -> ArithExpr

ghci> :t AEPlus
AEPlus :: ArithExpr -> ArithExpr -> ArithExpr

We know that constructors are essentially functions:

data AExpr where
  AENum  :: Int -> AExpr
  AEPlus :: AExpr -> AExpr -> AExpr
  AEAnd  :: AExpr -> AExpr -> AExpr
  AEGt   :: AExpr -> AExpr -> AExpr

GADT syntax gives you another style of declaring your data type:

So what... ? That's it !?

We have one more "useful" syntax sugar ?

GADTs power

data ArithExpr a where
  AENum  :: Int -> ArithExpr Int
  AEPlus :: ArithExpr Int -> ArithExpr Int -> ArithExpr Int
  AEAnd  :: ArithExpr Bool -> ArithExpr Bool -> ArithExpr Bool
  AEGt   :: ArithExpr Int -> ArithExpr Int -> ArithExpr Bool

How about this:

What happened?

We introduced type variable a and substituted Int or Bool depending on constructor.

interpret :: ArithExpr a -> a
interpret (AENum n) = n
interpret (AEPlus a b) = interpret a + interpret b
interpret (AEAnd a b) = interpret a && interpret b
interpret (AEGt a b) = interpret a > interpret b

GADTs usage

Usage of a GADT constructor is same as for regular one:

myExpr = ((AENum 23 `AEPlus` AENum 12) `AEGt` AENum 170)
           `AEAnd` (AENum 35 `AEGt` AENum 47)
ghci> interpret myExpr
False

ghci> myExpr 
23 + 12 > 170 && 35 > 47
ghci> interpret (AENum 12 `AEAnd` AENum 23)

error:
  • Couldn't match type ‘Bool’ with ‘Int’
    Expected type: ArithExpr Int
    Actual type: ArithExpr Bool
instance Show (ArithExpr a) where
  show (AEBool b) = show b
  show (AEGt a b) = show a <> " > " <> show b
  show (AEAnd a b) = show a <> " && " <> show b
  show (AENum a) = show a
  show (AEPlus a b) = show a <> " + " <> show b

Parsing GADT data type

Consider following "incomplete" parser:

parse
  :: String -> Maybe (ArithExpr a)
parse "1" = Just (AENum 1)
parse _ = Nothing

Surprise :)

ghci> :l DSL.hs
error:
    • Couldn't match type ‘a’ with ‘Int’
      Expected type: Maybe (ArithExpr a)
        Actual type: Maybe (ArithExpr Int)

Type of parse says that for every a given it will parse ArithExpr a.

Actually we want to say that for a valid string there exists such a that string is parsed to ArithExpr a.

Existential types

We introduce an existential type SomeAE:

data SomeAE where
  SomeAE :: Show a => ArithExpr a -> SomeAE

parse :: String -> Maybe SomeAE
parse "1" = Just (SomeAE $ AENum 1)
parse "1+2" = Just $ SomeAE $
  AENum 1 `AEPlus` AENum 2
parse _ = Nothing

interpretShow :: SomeAE -> String
interpretShow (SomeAE expr) =
    show (interpret expr)
ghci> interpretShow <$> parse "1+2"
Just "3"

Alternative syntax:

{-# LANGUAGE ExistentialQuantification #-}

data SomeAE =
  forall a. Show a => SomeAE (ArithExpr a)

Quantifier forall when used before constructor name is like lambda abstraction on types.

Unwrapping existential

How can I parse to integer expression?

data SomeAE where
  SomeAE :: (Typeable a, Show a) => ArithExpr a -> SomeAE
-- | The class 'Typeable' allows
-- a concrete representation of
-- a type to be calculated.
class Typeable (a :: k)

-- | Propositional equality.
-- If @a :~: b@ is inhabited by some
-- terminating value, then the type @a@
-- is the same as the type @b@.
data a :~: b where
  Refl :: a :~: a

-- | Extract a witness of equality
-- of two types
eqT
  :: forall a b. (Typeable a, Typeable b)
  => Maybe (a :~: b)
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

parseInt
  :: String -> Maybe (ArithExpr Int)
parseInt s = parse s >>=
  \(SomeAE (expr :: ArithExpr t)) ->
    do
      Refl <- eqT @t @Int
      pure expr
ghci> let aE = parseInt "1+2"
ghci> aE
Just 1 + 2
ghci> (^3) . interpret <$> aE
Just 27

forall

length :: [a] -> Int
length :: forall a . [a] -> Int
applyToTuple :: ([a] -> Int) -> ([b], [c]) -> (Int, Int)
applyToTuple f x y = (f x, f y)
-- Couldn't match type 'b' with 'a' ...
-- Couldn't match type 'c' with 'a' ...

Read as:

For every type a this function

can be considered to have type [a] → Int

Under the hood compiler quantifies all free variables:

When automatic quantification of all type variables is not sufficient?

RankNTypes extension

length :: forall a . [a] -> Int            -- Rank-1-Types
id     :: forall a . a -> a                -- Rank-1-Types
show   :: forall a . Show a => a -> String -- Rank-1-Types
{-# LANGUAGE RankNTypes #-}

applyToTuple :: (forall a. [a] -> Int) -> ([b], [c]) -> (Int, Int)
applyToTuple f (x, y) = (f x, f y)

applyToTuple length ("hello", [1,2,3])

{-# LANGUAGE RankNTypes #-}

Rank 0: Int
Rank 1: forall a . a -> Int
Rank 2: (forall a . a -> Int) -> Int           -- could be enabled by Rank2Types
Rank 3: ((forall a . a -> Int) -> Int) -> Int

A function type has rank n + 1 when its argument has rank n.

Int -> Int

Exercises:

Int -> Int                                   -- rank 0
forall a . a -> a
forall a . a -> a                            -- rank 1

The rank describes the depth at which universal quantifiers appear in a contravariant position, i.e. to the left of a function arrow.

(forall a . a -> a) -> Int
(forall a . a -> a) -> Int                   -- rank 2
Int -> (forall a . a -> a) 
forall a . Int -> a -> a                     -- rank 1
forall a b . a -> b -> a
forall a b . a -> b -> a                     -- rank 1 
forall a . a -> (forall b . b -> a)
(a -> a) -> (forall b . b -> b) -> (c -> c)
forall a b . a -> b -> a                     -- rank 1
(a -> a) -> (forall b . b -> b) -> (c -> c)  -- rank 2

Rank 2 type inference

ghci> reverse [2, 1, 3]
[3,1,2]
ghci> reverse [True, False]
[False,True]
applyTwo :: ([Int], [Bool])
applyTwo = let call f = (f [2, 1, 3], f [True, False]) in call reverse  -- (*)
-- but we get:
(*):29:
    No instance for (Num Bool) arising from the literal ‘2’
    In the expression: 2
    In the first argument of ‘f’, namely ‘[2, 1, 3]’
    In the expression: f [2, 1, 3]

(*):15:
    Couldn't match type ‘Int’ with ‘Bool’
    Expected type: ([Int], [Bool])
      Actual type: ([Int], [Int])
    In the expression: call reverse
    In the expression: let call f = (f ..., f ...) in call reverse

(*):20:
    Couldn't match type ‘Bool’ with ‘Int’
    Expected type: [Bool] -> [Int]
      Actual type: [Int] -> [Int]
    In the first argument of ‘call’, namely ‘reverse’
    In the expression: call reverse
-- and we want
gchi> applyTwo
([3,1,2], [False,True])

ST revisited

mutableAction :: Int
mutableAction = runST $ do
    var <- newSTRef 5
    changeVar var
    readSTRef newVar
changeVar :: STRef s Int -> ST s ()
changeVar var = runST $ do
  writeSTRef var 10
  writeSTRef var 42
    Couldn't match type ‘s’ with ‘s1’
      ‘s’ is a rigid type variable bound by
          the type signature for changeVarWrong :: STRef s a -> STRef s a
      ‘s1’ is a rigid type variable bound by
           a type expected by the context: ST s1 () at (*)
    Expected type: STRef s1 a
      Actual type: STRef s a
runST :: forall α. (forall s. ST s α) -> α

newSTRef :: forall α s. α -> ST s (STRef s α)
readSTRef :: forall α s. STRef s α -> ST s α
writeSTRef :: forall α s. STRef s α -> α -> ST s ()
mutableActionWrong :: Int
mutableActionWrong = runST $ do
    var <- newSTRef 5
    let newVar = changeVar var
    readSTRef newVar
changeVarWrong :: STRef s Int -> STRef s Int
changeVarWrong var =
  let _ = runST $ writeSTRef var 10
      _ = runST $ writeSTRef var 42
   in var

Forall in data types

data Ctx = Ctx { modulus :: Int }

newtype Action a = Action
  { runAction
      :: forall m .
        (MonadReader Ctx m, MonadCatch m)
      => m a }

Forall can be used inside data types:

expOrDefault
  :: Int -> Int -> Int -> Action Int
expOrDefault base pow def = Action $ do
  m <- asks modulus
  let r = base ^ pow
  (r `seq` pure (r `mod` m))
    `catchAny` \_ -> pure def

runPrint = runAction >=> print

main :: IO ()
main = flip runReaderT (Ctx 17) $ do
  runPrint $ expOrDefault 2 5  (-100)
  runPrint $ expOrDefault 2 (-1) (-100)

Don't confuse with existential:

data Action a = 
 forall m .
  (MonadReader Ctx m, MonadCatch m)
 => Action (m a)
data Action a where 
  Action :: forall m .
   (MonadReader Ctx m, MonadCatch m)
   => m a  
   -> Action a

Notice difference between "exists m such that .." and "forall m such that".

ScopedTypeVariables

calc :: Num a => a -> a -> a
calc a b = a + f b
  where
    f :: a -> a
    f = (+ 10)
Forall1.hs:40:10: error:
    • Could not deduce (Num a1)
      arising from a use of ‘+’
      from the context: Num a
calc2 :: Num a => a -> a -> a
calc2 a b = a + f b
  where
    f :: Num a => a -> a
    f = (+ 10)
ghci> calc2 2 4
16
calc2 :: Num a => a -> a -> a
calc2 a b = a + f b
  where
    f :: forall a. Num a => a -> a
    f = (+ 10)
{-# LANGUAGE ScopedTypeVariables #-}

calc3 :: forall a. Num a => a -> a -> a
calc3 a b = a + f b
  where
    f :: a -> a
    f = (+ 10)
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

calc3 :: forall a. Num a => a -> a -> a
calc3 a b = a + f @a b

f :: Num a => a -> a
f = (+ 10)

Scoped type variables and type applications are often combined :)

Alternative approach to DSLs

data ArithExpr a where
  AENum  :: Int -> ArithExpr Int
  AEPlus :: ArithExpr Int -> ArithExpr Int -> ArithExpr Int
  AEAnd  :: ArithExpr Bool -> ArithExpr Bool -> ArithExpr Bool
  AEGt   :: ArithExpr Int -> ArithExpr Int -> ArithExpr Bool

Recall DSL from previous slides:

Let's apply final tagless technique :)

myExpr = ((AENum 23 `AEPlus` AENum 12) `AEGt` AENum 170)
           `AEAnd` (AENum 35 `AEGt` AENum 47)
class ArithExpr expr where
  aeNum  :: Int -> expr Int
  aePlus :: expr Int -> expr Int -> expr Int
  aeAnd  :: expr Bool -> expr Bool -> expr Bool
  aeGt   :: expr Int -> expr Int -> expr Bool
myExpr :: ArithExpr expr => expr Bool
myExpr = ((aeNum 23 `aePlus` aeNum 12) `aeGt` aeNum 170)
           `aeAnd` (aeNum 35 `aeGt` aeNum 47)

Final tagless DSLs

class ArithExpr expr where
  aeNum  :: Int -> expr Int
  aePlus :: expr Int -> expr Int -> expr Int
  aeAnd  :: expr Bool -> expr Bool -> expr Bool
  aeGt   :: expr Int -> expr Int -> expr Bool
myExpr :: ArithExpr expr => expr Bool
myExpr = ((aeNum 23 `aePlus` aeNum 12)
           `aeGt` aeNum 170) `aeAnd`
           (aeNum 35 `aeGt` aeNum 47)
newtype ToS a = ToS {toString :: String}
  deriving (Show, Semigroup)

castTS :: ToS a -> ToS b
castTS (ToS s) = ToS s

instance ArithExpr ToS where
  aeNum = ToS . show
  aePlus a b = a <> (ToS " + ") <> b
  aeAnd a b = a <> (ToS " && ") <> b
  aeGt a b =
    castTS a <> (ToS " > ") <> castTS b
newtype Interpret a =
  Interpret { interpret :: a }

instance ArithExpr Interpret where
  aeNum = Interpret
  aePlus a b = Interpret $
    interpret a + interpret b
  aeAnd a b = Interpret $
    interpret a && interpret b
  aeGt a b = Interpret $
    interpret a > interpret b
ghci> toString myExpr
"23 + 12 > 170 && 35 > 47"

ghci> interpret myExpr
False

Why care about DSLs?

With power of type system, extensive syntax and support of both strict and lazy, pure and effectful computations,

Haskell is great for embedded DSLs.

Realistic example:

Code in Michelson language 

Code in Haskell 1:1 eDSL

code {
  DUP; CAR; DIP { CDR; };
  CONS;
  NIL operation; PAIR;
};
code =
  DUP # CAR # DIP CDR #
  CONS #
  NIL operation # PAIR

Michelson type system was implemented in Haskell types, hence writing in eDSL we offload dirty work to Haskell typechecker.

Promoted Literature for all

Lecture 11: Brand new DSL world

By ITMO CTD Haskell

Lecture 11: Brand new DSL world

Lecture about GADT, Data kinds, ...

  • 3,319