Module 17: Deeply embedded EDSLs

Due: Thursday, 17 November 2016 @ 1:15pm

Write your team names here:

Recall from last week that there are two types of embedded domain-specific languages: shallow EDSLs work directly with the semantics of the language; deep EDSLs construct abstract syntax trees, which can be later interpreted or compiled. A deep EDSL is more work to build, but can have many benefits, some of which we will explore today:

It’s possible to implement other phases (like error checking, optimization, or desugaring) before interpreting.
One is not limited to a single semantics; it’s possible to interpret the same AST in multiple ways (to compile or interpret it, analyze it, etc.).

> {-# LANGUAGE FlexibleInstances    #-}
> {-# LANGUAGE GADTs                #-}
> {-# LANGUAGE TypeSynonymInstances #-}
> {-# LANGUAGE ViewPatterns         #-}
> 
> import           Codec.Picture
> import           Data.Colour
> import           Data.Colour.Names
> import           Data.Colour.SRGB
> import           Data.Word

The Quilt AST

Here’s the AST type we will use to represent Quilt programs (at least for now; you are welcome to add features if you wish).

> type Color  = Colour Double
> type Number = Double
> 
> data Coord where
>   X :: Coord
>   Y :: Coord
> 
> data Quilt a where
>   QSolid :: a -> Quilt a
>   QCoord :: Coord -> Quilt Number
>   QGrey  :: Quilt Number -> Quilt Color
>   QIf    :: Quilt Bool -> Quilt a -> Quilt a -> Quilt a
>   QQuilt :: Quilt a -> Quilt a -> Quilt a -> Quilt a -> Quilt a
>   QMap   :: (a -> b) -> Quilt a -> Quilt b
>   QZip   :: (a -> b -> c) -> Quilt a -> Quilt b -> Quilt c
>   QRot   :: Quilt a -> Number -> Quilt a

GADT stands for Generalized Algebraic Data Types; the Generalized refers to the way that constructors of the Quilt type above do not always construct a Quilt a, but sometimes construct something more specific such as a Quilt Number or Quilt Color (but they still have to construct some sort of Quilt). Note how the types of the Quilt constructors essentially encode the type system for the language. For example, QIf :: Quilt Bool -> Quilt a -> Quilt a -> Quilt a specifies that the first argument to QIf must be a quilt of booleans; the branches must have the same type as each other; and the result of the whole expression will be the same as the types of the branches.

Note that QRot represents rotations, and only takes a Number instead of a Quilt Number. So we can only rotate by a single number instead of by a number that varies over the plane. The reason for this restriction will become clear later; though note that we could also add a constructor for generalized rotation taking a Quilt Number if we wanted.

Complete the function definitions below. In the shallow version of the Quilt EDSL, these functions actually actually did some semantic work. In this version, all they will do is construct ASTs. Note: if you are tempted to add a new constructor for (<.), think again.

> quilt :: Quilt a -> Quilt a -> Quilt a -> Quilt a -> Quilt a
> quilt = undefined
> 
> solid :: a -> Quilt a
> solid = undefined
> 
> x :: Quilt Number
> x = undefined
> 
> y :: Quilt Number
> y = undefined
> 
> mkGrey :: Quilt Number -> Quilt Color
> mkGrey = undefined
> 
> ifQ :: Quilt Bool -> Quilt a -> Quilt a -> Quilt a
> ifQ = undefined
> 
> (<.) :: Ord a => Quilt a -> Quilt a -> Quilt Bool
> (<.) = undefined
> 
> mapQuilt :: (a -> b) -> Quilt a -> Quilt b
> mapQuilt = undefined
> 
> zipQuilt :: (a -> b -> c) -> Quilt a -> Quilt b -> Quilt c
> zipQuilt = undefined
> 
> rot :: Quilt a -> Number -> Quilt a
> rot = undefined

Below I have duplicated the code from last week for doing arithmetic on colors and quilts, as well as the instances of Fractional and Floating that you wrote for quilts. Note that all this code is entirely unchanged from last week: it all works in terms of solid, mapQuilt, and zipQuilt, which you implemented above.

> 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
> 
> instance Num a => Num (Quilt a) where
>   (+)           = zipQuilt (+)
>   (-)           = zipQuilt (-)
>   (*)           = zipQuilt (*)
>   abs           = mapQuilt abs
>   signum        = mapQuilt signum
>   fromInteger i = solid (fromInteger i)
> 
> instance Fractional a => Fractional (Quilt a) where
>   fromRational = solid . fromRational
>   (/) = zipQuilt (/)
> 
> instance Floating a => Floating (Quilt a) where
>   pi    = solid pi
>   exp   = mapQuilt exp
>   log   = mapQuilt log
>   sin   = mapQuilt sin
>   cos   = mapQuilt cos
>   asin  = mapQuilt asin
>   acos  = mapQuilt acos
>   atan  = mapQuilt atan
>   sinh  = mapQuilt sinh
>   cosh  = mapQuilt cosh
>   asinh = mapQuilt asinh
>   acosh = mapQuilt acosh
>   atanh = mapQuilt atanh

Interpreting typed ASTs

ROTATE ROLES and write the name of the new driver here:

Now that we can build up Quilt ASTs, we need a way to interpret them, of course.

Complete the implementation of interp below.

> type QuiltFun a = Double -> Double -> a
> 
> interp :: Quilt a -> QuiltFun a
> interp = undefined

Beautiful, isn’t it? Notice that interp doesn’t have to return any sort of Either Error—and not only that, it doesn’t even have to make any assumptions about the values produced by recursive calls to interp! When interp is called on a Quilt Bool, we get actual Bool values out, or Number values from a Quilt Number, and so on—the type of interp guarantees this. In the past we had to use some Value type and carefully keep track of our assumptions about how we interpreted different types (e.g. interpreting False as 0 and True as 1), and there was always the possibility of a bug in our type checker throwing things off. But now there is no possibility of error in type checking—since it’s being done by the Haskell type system—and no assumptions to keep track of in our interpreter.

Write a smiley face here once you have read and understood the above paragraph:

The below definition of renderQuilt is taken from our shallow EDSL. Uncomment it (by removing the spaces from before it) and fix it to work with this new version of the EDSL.

> 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

Try some examples to make sure everything works properly.
Copy the quilterate function from the previous module. How does it have to be modified to work with this new version of the EDSL?
Try an example or two using quilterate to make sure it works.

What to do with an AST, part I: optimization

ROTATE ROLES and write the name of the new driver here:

So far, we have simply reimplemented the same functionality we already had with our shallow EDSL. Now that we build an AST, however, it opens up many possibilities.

Consider the following function, which repeatedly rotates a quilt by 5 degrees:

> nudge :: Int -> Quilt a -> Quilt a
> nudge 0 q = q
> nudge n q = nudge (n-1) q `rot` 5

(This function is not very realistic, but it’s not hard to imagine more realistic things with similar characteristics.)

> nudgy :: Quilt Color
> nudgy = nudge 100 (ifQ (x <. y) (solid red) (solid blue))

Render nudgy. How long does it take?
Why do you think it takes so long?

The point is that doing repeated rotations is silly: we should just do one rotation instead. For example, rotating by 10 degrees and then rotating by 20 degree is the same as doing one rotation by 30 degrees. The idea will be to write a function that transforms Quilt ASTs, collapsing multiple consecutive rotations into one.

Write a function opt :: Quilt a -> Quilt a. It should collapse all consecutive QRot constructors into one QRot constructor, adding the rotations. (Hint: if you see two consecutive QRot constructors, collapse them, and then re-call opt on the result.) Be sure to deal with QRot constructors buried somewhere inside an AST.
Now modify renderQuilt to call opt before calling interp.
Re-render nudgy. Is it faster now?
We can’t make a Show instance for Quilt since it contains functions (actually that’s not even the only reason). However, ghci can do a decent job of showing values in a hacky way. Try typing :force nudgy at the ghci prompt.
Now define nudgy' = opt nudgy and then type :force nudgy'.

What to do with an AST, part II: analysis

ROTATE ROLES and write the name of the new driver here:

Once we have a Quilt AST we don’t just have to interpret it. We can do anything else we like with it.

As a simple example, complete the definition of quiltSize below.

> quiltSize :: Quilt a -> Int
> quiltSize = undefined

quiltSize should compute the number of Quilt constructors in an AST. For example, the size of QSolid is 1; the size of QIf t q1 q2 is one more than the sum of the sizes of t, q1, and q2; and so on.

Try evaluating quiltSize nudgy and quiltSize (opt nudgy).

Feedback

How long would you estimate that you spent working on this module?
Were any parts particularly confusing or difficult?
Were any parts particularly fun or interesting?
Record here any other questions, comments, or suggestions for improvement.

Support code

> 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