data Lecture n where

 DSLs :: Lecture 11

Lecture plan

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

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 an 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 a simple ADT

Do you see any problems?

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 problems now?

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

Are dynamic types unavoidable?

Intuition behind GADTs

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

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

We know that constructors are essentially functions:

{-# LANGUAGE GADTs #-}

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

The GADT syntax gives you another style of declaring your algebraic datatype:

So... That's it!? We have yet another "useful" syntactic sugar?

The power of GADTs

{-# LANGUAGE GADTs #-}

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 the GADT constructors is same as with the regular ones:

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 (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 a GADT

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)

The type of parse says that for every a given it will parse the string to ArithExpr a.

Actually we want to say that for a valid string there exists such a that the 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)

The universal quantifier forall when used before the constructor is like a lambda abstraction on types.

Unwrapping an existential type

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 #-}

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 the compiler quantifies all type variables as follows:

When is automatic quantification of all type variables not sufficient?

:set -XRankNTypes

length :: forall a . [a] -> Int             -- Rank-1 type
id     :: forall a . a -> a                 -- Rank-1 type
show   :: forall a . Show a => a -> String  -- Rank-1 type
{-# 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])

What are Rank-N types?

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

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

Int -> Int

Quiz time

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

A rank describes the depth at which universal quantifiers appear in the 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 = 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
changeVar' :: STRef s Int -> STRef s Int
changeVar' var =
  let _ = runST $ writeSTRef var 10
      _ = runST $ writeSTRef var 42
   in var

Forall in datatypes

data Ctx = Ctx { modulus :: Int }

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

Forall can be used inside the constructors:

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 types:

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 the DSL from the previous slides:

Let's apply the tagless final pattern/style :)

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 the power of its type system, extensive syntax, and support of both strict and lazy, pure and effectful computations, Haskell is great tool for creation of embedded DSLs (eDSLs).

Real-life example:

Code in the Michelson language

Code in the Haskell eDSL (1:1)

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

The Michelson type system was implemented in Haskell types, hence by writing an eDSL we offload dirty work to Haskell's type checker.

Promoted Literature for all

Made with Slides.com