Module 17: Deeply embedded EDSLs

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

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:

> {-# 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.

> 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

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

> 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.

What to do with an AST, part I: optimization

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))

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.

What to do with an AST, part II: analysis

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

> 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.

Feedback

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