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
![](../images/green.png)
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.
![](../images/green.png)
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 consecutiveQRot
constructors into oneQRot
constructor, adding the rotations. (Hint: if you see two consecutiveQRot
constructors, collapse them, and then re-callopt
on the result.) Be sure to deal withQRot
constructors buried somewhere inside an AST.Now modify
renderQuilt
to callopt
before callinginterp
.Re-render
nudgy
. Is it faster now?We can’t make a
Show
instance forQuilt
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 theghci
prompt.Now define
nudgy' = opt nudgy
and then type:force nudgy'
.
![](../images/green.png)
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
andquiltSize (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