Module 16: Embedded domain-specific languages

Due: Tuesday, 15 November at 1:15pm

A domain-specific language (DSL) is a language that is designed to solve problems in a particular domain—as opposed to a general-purpose language.

In a traditional implementation of a DSL, we just write a standalone parser, type checker, interpreter, and so on.

An embedded (domain-specific) language (EDSL) piggybacks on an existing “host” language, i.e. the language is really “just” a library in the host language. Then EDSL programs are programs in the host language which use things from the library.

It is not particularly important to distinguish between libraries on the one hand and EDSLs on the other. They are on a spectrum. In one sense, any library can be considered an EDSL. This means it makes sense to apply tools of language design to thinking about library API design.

Quilt as a Haskell EDSL

As we will see, Haskell makes a particularly good host language for EDSLs (because of things like generally clean syntax, user-defined operators, first-class functions, and many abstraction mechanisms such as type classes).

The first question we should ask when designing any DSL: what are the types? In Quilt, we had Booleans, Numbers, and Colors, all of which could vary over the plane.

In our EDSL version, we will still be able to have normal Haskell (non-varying) booleans, numbers, and so on, so it will be useful to distinguish between single values and values that vary over the plane.

> {-# LANGUAGE FlexibleInstances    #-}
> {-# LANGUAGE TypeSynonymInstances #-}
> {-# LANGUAGE ViewPatterns         #-}
> 
> import           Codec.Picture
> import           Data.Colour
> import           Data.Colour.Names
> import           Data.Colour.SRGB
> import           Data.Complex
> import           Data.Word
> 
> type Color  = Colour Double   -- from the 'colour' library (cabal install colour)
> type Number = Double

This is what is known as a shallow embedding: everything deals directly with the desired semantics. So we just define a quilt as a function that takes two Double. Note we can make it polymorphic: a Quilt a, for some type a, is an a that varies over the plane. So ultimately we will render a Quilt Color, but we have seen how it is useful to also have things like Quilt Bool.

> type Quilt a = Double -> Double -> a

Here is some stuff the Quilt language from project 3 had, that we’d like to develop in this EDSL setting:

Let’s start with the quilt operator. In project 3, quilt was just arbitrary syntax that we parsed, type checked, and interpreted. In our EDSL, quilt will be a Haskell function. Its implementation will be the quilt code from the interpreter; its type should encode the typing rules for quilt.

A first try might be:

quilt :: Color -> Color -> Color -> Color -> Quilt Color

but this would only allow us to make quilts with four solid color blocks. The quilt operator was definitely more powerful than this!

A second try:

quilt :: Quilt Color -> Quilt Color -> Quilt Color -> Quilt Color -> Quilt Color

This is better, but still doesn’t capture everything: recall we could also use quilt on e.g. quilts of numbers, or quilts of booleans.

Here’s the real type we want, and the implementation (lifted straight from your interpreter):

> quilt :: Quilt a -> Quilt a -> Quilt a -> Quilt a -> Quilt a
> quilt q1 q2 q3 q4 = \x y ->
>   case (x < 0, y > 0) of
>     (True , True)  -> q1 (2*x + 1) (2*y - 1)
>     (True , False) -> q3 (2*x + 1) (2*y + 1)
>     (False, True)  -> q2 (2*x - 1) (2*y - 1)
>     (False, False) -> q4 (2*x - 1) (2*y + 1)

quilt works on four Quilt values of any type a (as long as they are all the same type).

However, note we can’t write quilt red green blue purple like we could in the original Quilt language. That was handled by subtyping, but Haskell doesn’t have subtyping. So we have to introduce functions to do subtyping explicitly. This is one tradeoff of doing Quilt as an EDSL.

> solid :: a -> Quilt a
> solid c = \_ _ -> c

We can develop a few more pieces of the language.

> x :: Quilt Number
> x = \x y -> x
> 
> y :: Quilt Number
> y = \x y -> y
> 
> mkGrey :: Quilt Number -> Quilt Color
> mkGrey q = \x y -> let n = q x y in sRGB n n n

We can’t use normal Haskell if, so we make our own ifQ function which works on Quilts. (Actually, we can use Haskell’s if ... then ... else syntax with the RebindableSyntax extension, which allows us redefine how if ... then ... else works! But we won’t go into that now.)

> ifQ :: Quilt Bool -> Quilt a -> Quilt a -> Quilt a
> ifQ test a b = \x y -> case test x y of
>   True  -> a x y
>   False -> b x y

We also can’t use the < operator since it returns a Bool, and we want a Quilt Bool. So we make our own called <..

> infixl 4 <.
> 
> (<.) :: Ord a => Quilt a -> Quilt a -> Quilt Bool
> q1 <. q2 = \x y -> q1 x y < q2 x y

At this point we can now try things like

renderQuilt 256 "quilt.png" (ifQ (x <. y) (solid red) (solid blue))

We also note that we get lots of cool stuff from Haskell for free, like let-expressions and variables, recursive functions, …

> quilterate :: Int -> Quilt a -> Quilt a
> quilterate 0 q = q
> quilterate n q = let q' = quilterate (n-1) q in quilt q' q' q' q'

Overloading

quilt and + were both overloaded to work on multiple types. However, they worked rather differently.

In Haskell, arithmetic is governed by the Num type class. We can get + and friends to work on things like colors just by making a new instance of the Num class for Color.

> mapColor :: (Double -> Double) -> Color -> Color
> mapColor f (toSRGB -> RGB r g b) = sRGB (f r) (f g) (f b)
> 
> zipColor :: (Double -> Double -> Double) -> Color -> Color -> Color
> zipColor (&) (toSRGB -> RGB r1 g1 b1) (toSRGB -> RGB r2 g2 b2)
>   = sRGB (r1 & r2) (g1 & g2) (b1 & b2)
> 
> instance Num Color where
>   (+) = zipColor (+)
>   (-) = zipColor (-)
>   (*) = zipColor (*)
>   abs = mapColor abs
>   signum = mapColor signum
> 
>   fromInteger i = sRGB i' i' i'
>     where i' = fromInteger i

We can make an instance of Num for Quilt, too:

> zipQuilt :: (a -> b -> c) -> Quilt a -> Quilt b -> Quilt c
> zipQuilt (&) q1 q2 = \x y -> q1 x y & q2 x y
> 
> mapQuilt :: (a -> b) -> Quilt a -> Quilt b
> mapQuilt f q = \x y -> f (q x y)
> 
> instance Num a => Num (Quilt a) where
>   (+) = zipQuilt (+)
>   (-) = zipQuilt (-)
>   (*) = zipQuilt (*)
>   abs = mapQuilt abs
>   signum = mapQuilt signum
>   fromInteger i = \x y -> fromInteger i

Now we can try things like

(ifQ (x <. y) (solid red) (solid blue)) + (ifQ (-x <. y) (solid green) (solid purple))

It’s worth thinking carefully about how the -x works: it turns into a call to the negate function of the Num class, which by default is implemented as negate x = fromInteger 0 - x. So it uses our implementation of (-) for Quilt. Note also that the central addition is adding two Quilt Colors. To do this, it first calls (+) for Quilt, which uses zipQuilt to apply (+) to every point in the quilts. This (+) in turn is the version of (+) for Color.

Your turn

Notice how we have to use mkGrey and solid.

Now let’s add some geometric transformations.

By the power of EDSLs

> z :: Quilt (Complex Double)
> z = (:+)
> 
> fromComplex :: (Complex Double -> a) -> Quilt a
> fromComplex f = mapQuilt f z
> 
> mysteryCount :: Quilt Int
> mysteryCount = fromComplex $ \c ->
>   length . take 100 . takeWhile ((< 2) . magnitude) . iterate (f c) $ 0
>   where
>     f c w = w*w + c
> 
> mystery :: Quilt Color
> mystery = mkGrey $ mapQuilt pickColor mysteryCount
>   where
>     pickColor n = logBase 2 (fromIntegral n) / 7

Rendering

You can ignore the code below, it just does the work of rendering a Quilt Color to an image file.

> renderQuilt :: Int -> FilePath -> Quilt Color -> IO ()
> renderQuilt qSize fn q = do
>   let q' r c = q (2*(fromIntegral r / fromIntegral qSize) - 1)
>                  (-(2*(fromIntegral c / fromIntegral qSize) - 1))
>       img    = ImageRGB8 $ generateImage (\r c -> toPixel $ q' r c) qSize qSize
>   savePngImage fn img
> 
> toPixel :: Color -> PixelRGB8
> toPixel (toSRGB -> RGB r g b) = PixelRGB8 (conv r) (conv g) (conv b)
>   where
>     conv :: Double -> Word8
>     conv v = fromIntegral . clamp $ floor (v * 256)
>     clamp :: Int -> Int
>     clamp v
>       | v > 255   = 255
>       | v < 0     = 0
>       | otherwise = v