• Back to main page

Module 12: Embedded domain-specific languages

• Write your team names here:

• Type stack install colour at a command prompt to install the colour package which you will need for this module.

Embedded Domain-Specific Languages

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.

• Pro: this gives us total control over the language!
• Con: it is a lot of work!

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.

• Pro: it is a lot less work, and we get a lot of stuff for free.
• Con: design of the EDSL is constrained; we have to “shoehorn” the EDSL into the host language.

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 (stack 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 Doubles. 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:

• arithmetic (on numbers or colors)
• if statements
• \(x\), \(y\)
• quilt
• comparison operators
• color names
• Booleans
• numbers
• color literals (lists)

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.

• Fill in the definitions of solid, x, y, and mkGrey below. For mkGrey, you can use the sRGB function to create a Color from three R, G, B values.

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

x :: Quilt Number
x = \x _ -> x

y :: Quilt Number
y = \_ 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.)

• Define a function ifQ with an appropriate type, and fill in its implementation.

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.

• quilt works for any type, and it does the same thing no matter which type is used. This is called parametric polymorphism, and corresponds to e.g. Java generics. It also coresponds to Haskell’s polymorphism. This is why the type for quilt above was Quilt a -> ..., indicating that quilt will work for any type a.

• Addition, on the other hand, only works on specific types, and it works in a different way specific to each one. For example, on numbers it does normal addition; on colors it adds channels componentwise. This is called ad-hoc polymorphism, and corresponds to Java interfaces, subclassing, and method overloading. It also corresponds to Haskell type classes.

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

• Your turn: make an instance of Num for Quilt a.

mapQuilt :: (a -> b) -> Quilt a -> Quilt b
mapQuilt = undefined

zipQuilt :: (a -> b -> c) -> Quilt a -> Quilt b -> Quilt c
zipQuilt = undefined

instance Num a => Num (Quilt a) where

Now you should be able to 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.

• Make instances of the Fractional and Floating type classes for Quilt a. These instances will be similar to the instance for Num.

• You should now be able to render examples like
  • mkGrey $ sin (8*pi*x)
  • mkGrey ((x + 1)/2) * solid red + mkGrey ((y+1)/2) * solid blue

Notice how we have to use mkGrey and solid.

• What is the type of ((x+1)/2)?

• What is the type of mkGrey ((x+1)/2)?

• What is the type of red?

• What is the type of solid red?

Now let’s add some geometric transformations.

• Implement functions tx, ty, scale, and rot to do translation, scaling, and rotation, respectively. Part of the exercise is to figure out appropriate types for these functions.

• Now translate the very first example (swirl) on the project 3 page into our EDSL and make sure it produces the same image.

By the power of EDSLs

• Try rendering mystery below. For optimal viewing, translate it 0.5 units in the positive x direction first.

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

• Explain why this is a good example of one of the benefits of using an EDSL. Why would it have been difficult to produce this image using the non-embedded Quilt language from project 3?

• Play around and make at least two other cool example images. Try to create images that take advantage of the EDSL, i.e. images that would have been difficult or impossible to make with project 3.

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