├── Lang.hs ├── README.md └── edsl.pdf /Lang.hs: -------------------------------------------------------------------------------- 1 | -- #+TITLE: Framing the Discussion 2 | -- #+DATE: 3 | -- #+AUTHOR: Anthony Cowley 4 | -- #+EMAIL: acowley@gmail.com 5 | -- #+DESCRIPTION: Framing the Discussion Code 6 | -- #+EXCLUDE_TAGS: noexport 7 | -- #+KEYWORDS: 8 | -- #+LANGUAGE: en 9 | -- #+SELECT_TAGS: export 10 | -- #+STARTUP: beamer 11 | -- #+STARTUP: oddeven 12 | -- #+LaTeX_CLASS: beamer 13 | -- #+LaTeX_CLASS_OPTIONS: [bigger] 14 | -- #+OPTIONS: H:2 toc:t 15 | -- #+BEAMER_FRAME_LEVEL: 2 16 | -- #+COLUMNS: %40ITEM %10BEAMER_env(Env) %9BEAMER_envargs(Env Args) %4BEAMER_col(Col) %10BEAMER_extra(Extra) 17 | -- #+BEAMER_HEADER_EXTRA: \usetheme{default}\usecolortheme{default} 18 | -- #+LaTeX_HEADER: \usepackage[english]{babel} 19 | -- #+LaTeX_HEADER: \usepackage{xltxtra} 20 | -- #+LaTeX_HEADER: \setmainfont{Menlo} 21 | -- #+LaTeX_HEADER: \usepackage{minted} 22 | -- #+LaTeX_HEADER: \usemintedstyle{colorful} 23 | -- #+LaTeX_HEADER: \newminted{haskell}{fontsize=\footnotesize,fontseries=b} 24 | -- #+LaTeX_HEADER: \usepackage{upquote} 25 | -- #+LaTeX_HEADER: \AtBeginDocument{% 26 | -- #+LaTeX_HEADER: \def\PYZsq{\textquotesingle}% 27 | -- #+LaTeX_HEADER: } 28 | 29 | -- #+BEGIN_LaTeX 30 | -- \let\Oldpyg\PYGcolorful 31 | -- \renewcommand{\PYGcolorful}[2]{\ifthenelse{\equal{#1}{err}} {#2} {\Oldpyg{#1}{#2}}} 32 | -- #+END_LaTeX 33 | 34 | -- #+name: setup-minted 35 | -- #+begin_src emacs-lisp :exports both :results silent 36 | -- (setq org-latex-listings 'minted) 37 | -- (setq org-latex-custom-lang-environments 38 | -- '( 39 | -- (haskell "haskellcode") 40 | -- )) 41 | -- (setq org-latex-minted-options 42 | -- '(("frame" "lines") 43 | -- ("fontseries" "eb") 44 | -- ("fontsize" "\\scriptsize") 45 | -- ("linenos" ""))) 46 | -- (setq org-latex-to-pdf-process 47 | -- '("xelatex -shell-escape -interaction nonstopmode -output-directory %o %f" 48 | -- "xelatex -shell-escape -interaction nonstopmode -output-directory %o %f" 49 | -- "xelatex -shell-escape -interaction nonstopmode -output-directory %o %f")) 50 | -- #+end_src 51 | 52 | -- * Preamble :noexport: 53 | {-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances, 54 | GADTs, KindSignatures, MultiParamTypeClasses, PolyKinds, 55 | RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, 56 | DefaultSignatures, PatternSynonyms, UndecidableInstances, 57 | OverlappingInstances #-} 58 | module Lang where 59 | import Control.Applicative 60 | import GHC.Prim (Constraint) 61 | 62 | -- * Basics 63 | -- ** Tagged Initial 64 | 65 | data LangI a where 66 | LiftI :: a -> LangI a 67 | AddI :: LangI Int -> LangI Int -> LangI Int 68 | LamI :: (LangI a -> LangI b) -> LangI (a -> b) 69 | AppI :: LangI (a -> b) -> LangI a -> LangI b 70 | 71 | -- ** Interpreter 72 | 73 | interp :: LangI a -> a 74 | interp (LiftI x) = x 75 | interp (AddI x y) = interp x + interp y 76 | interp (LamI f) = interp . f . LiftI 77 | interp (AppI f x) = interp f (interp x) 78 | 79 | instance Num a => Num (LangI a) where 80 | fromInteger = LiftI . fromInteger 81 | 82 | -- ** Example 83 | testI1 :: Int 84 | testI1 = interp (AddI 2 3) 85 | 86 | -- #+BEGIN_EXAMPLE 87 | -- λ> testI1 88 | -- 5 89 | -- #+END_EXAMPLE 90 | 91 | testI2 :: Int 92 | testI2 = interp (AppI (LamI $ \x -> AddI 2 x) 3) 93 | -- #+BEGIN_EXAMPLE 94 | -- λ> testI2 95 | -- 5 96 | -- #+END_EXAMPLE 97 | 98 | testI2' :: Int 99 | testI2' = interp (AppI (LamI $ AddI 2) 3) 100 | 101 | -- ** Tagless Final 102 | class ArithF e where 103 | lit :: Int -> e Int 104 | add :: e Int -> e Int -> e Int 105 | 106 | class AbsF e where 107 | lam :: (e a -> e b) -> e (a -> b) 108 | app :: e (a -> b) -> e a -> e b 109 | 110 | class FancyF e where 111 | fancyOp :: e Int -> e Int 112 | 113 | -- ** Identity :noexport: 114 | newtype Identity a = Identity { runIdentity :: a } 115 | instance Functor Identity where 116 | fmap f (Identity x) = Identity (f x) 117 | instance Applicative Identity where 118 | pure = Identity 119 | Identity f <*> Identity x = Identity (f x) 120 | 121 | -- ** Our first compiler backend 122 | instance ArithF Identity where 123 | lit = pure 124 | add = liftA2 (+) 125 | 126 | instance AbsF Identity where 127 | lam f = Identity (runIdentity . f . Identity) 128 | app = (<*>) 129 | 130 | instance FancyF Identity where 131 | fancyOp = fmap (+42) 132 | 133 | -- ** Compositional Language 134 | -- :PROPERTIES: 135 | -- :BEAMER_act: [<+->] 136 | -- :END: 137 | -- *** 138 | type MyLang e = (ArithF e, AbsF e) 139 | 140 | testSum :: MyLang e => e Int 141 | testSum = add (lit 2) (lit 3) 142 | 143 | -- *** 144 | -- #+BEGIN_EXAMPLE 145 | -- λ> runIdentity testSum 146 | -- 5 147 | -- #+END_EXAMPLE 148 | 149 | -- ** Code Generation 150 | newtype Code a = Code { getCode :: Int -> String } 151 | 152 | instance ArithF Code where 153 | lit = Code . const . show 154 | add (Code x) (Code y) = Code $ \n -> 155 | "(" ++ x n ++ " + " ++ y n ++ ")" 156 | 157 | instance AbsF Code where 158 | lam f = Code $ \n -> 159 | let x = "x_"++show n 160 | Code body = f (Code $ const x) 161 | subst = body (n+1) 162 | in concat ["(\\",x," -> ",subst,")"] 163 | app (Code f) (Code x) = 164 | Code $ \n -> concat ["(",f n," ",x n,")"] 165 | 166 | -- ** Hardware SDK 167 | instance FancyF Code where 168 | fancyOp (Code x) = 169 | Code $ \n -> "(hardwareOperation "++x n++")" 170 | 171 | -- ** Code Generation Test 172 | -- :PROPERTIES: 173 | -- :BEAMER_act: [<+->] 174 | -- :END: 175 | -- *** 176 | -- #+BEGIN_EXAMPLE 177 | -- λ> getCode testSum 0 178 | -- "(2 + 3)" 179 | -- #+END_EXAMPLE 180 | -- *** 181 | testLam :: MyLang e => e (Int -> Int) 182 | testLam = lam $ \x -> add x x 183 | 184 | -- #+BEGIN_EXAMPLE 185 | -- λ> putStrLn $ getCode testLam 1 186 | -- (\x_1 -> (x_1 + x_1)) 187 | -- #+END_EXAMPLE 188 | 189 | -- ** Elem :noexport: 190 | data Elem (x :: k) (xs :: [k]) where 191 | Here :: Elem x (x ': xs) 192 | There :: Elem x xs -> Elem x (y ': xs) 193 | 194 | class Implicit a where 195 | implicitly :: a 196 | 197 | instance Implicit (Elem x (x ': xs)) where implicitly = Here 198 | instance Implicit (Elem x xs) => Implicit (Elem x (y ': xs)) where 199 | implicitly = There implicitly 200 | 201 | type IElem x xs = Implicit (Elem x xs) 202 | type El x xs = IElem x xs 203 | 204 | -- ** Indexed Initial Encoding 205 | data LangIG = ArithIG | FancyIG 206 | 207 | -- ** Singletons 208 | data family LangSing :: k -> * 209 | 210 | data instance LangSing (a::LangIG) where 211 | SArithIG :: LangSing ArithIG 212 | SFancyIG :: LangSing FancyIG 213 | 214 | class ISing (a :: k) where sing :: LangSing a 215 | instance ISing ArithIG where sing = SArithIG 216 | instance ISing FancyIG where sing = SFancyIG 217 | 218 | -- ** More Singletons :noexport: 219 | data instance LangSing (a::LangME) where 220 | SArithME :: LangSing ArithME 221 | SFancyME :: LangSing FancyME 222 | 223 | data instance LangSing (a::LangFI) where 224 | SArithFI :: LangSing ArithFI 225 | SFancyFI :: LangSing FancyFI 226 | 227 | data instance LangSing (a::LangPF) where 228 | SArithPF :: LangSing ArithPF 229 | SFancyPF :: LangSing FancyPF 230 | SAbsPF :: LangSing AbsPF 231 | 232 | instance ISing ArithME where sing = SArithME 233 | instance ISing FancyME where sing = SFancyME 234 | instance ISing ArithFI where sing = SArithFI 235 | instance ISing FancyFI where sing = SFancyFI 236 | instance ISing ArithPF where sing = SArithPF 237 | instance ISing FancyPF where sing = SFancyPF 238 | instance ISing AbsPF where sing = SAbsPF 239 | 240 | -- ** Indexed Initial Encoding 241 | -- *** Modularly Tagged 242 | 243 | data family Repr :: k -> [k] -> (* -> *) -> * -> * 244 | 245 | data TermIG :: [LangIG] -> (* -> *) -> * -> * where 246 | TermIG :: (El lang langs) 247 | => LangSing lang 248 | -> Repr lang langs e a 249 | -> TermIG langs e a 250 | 251 | -- ** Defining a tagged sub-language 252 | 253 | -- *** A Family of Tags 254 | data instance Repr ArithIG langs e a where 255 | LitIG :: Int -> Repr ArithIG langs e Int 256 | AddIG :: TermIG langs e Int 257 | -> TermIG langs e Int 258 | -> Repr ArithIG langs e Int 259 | 260 | data instance Repr FancyIG langs e a where 261 | FancyOpIG :: TermIG langs e Int 262 | -> Repr FancyIG langs e Int 263 | 264 | -- ** Helper 265 | termIG :: (El lang langs, ISing lang) 266 | => Repr lang langs e a -> TermIG langs e a 267 | termIG = TermIG sing 268 | 269 | -- ** Indexed Initial Evaluation 270 | -- :PROPERTIES: 271 | -- :BEAMER_act: [<+->] 272 | -- :END: 273 | -- *** 274 | type MyLangIG = [ArithIG, FancyIG] 275 | 276 | -- *** 277 | evalIG :: TermIG MyLangIG e a -> a 278 | evalIG (TermIG SArithIG (LitIG x)) = x 279 | evalIG (TermIG SArithIG (AddIG x y)) = 280 | evalIG x + evalIG y 281 | evalIG (TermIG SFancyIG (FancyOpIG x)) = 282 | evalIG x + 42 283 | 284 | -- ** Indexed Initial testSum 285 | testSumIG :: TermIG MyLangIG e Int 286 | testSumIG = termIG (AddIG (termIG (LitIG 2)) 287 | (termIG (LitIG 3))) 288 | 289 | -- #+BEGIN_EXAMPLE 290 | -- λ> evalIG testSumIG 291 | -- 5 292 | -- #+END_EXAMPLE 293 | 294 | -- ** Modular Evaluation 295 | data LangME = ArithME | FancyME 296 | 297 | class EvalME (lang :: LangME) where 298 | evalME :: (forall a. TermME langs Identity a -> a) 299 | -> Repr lang langs Identity r -> r 300 | 301 | data TermME :: [LangME] -> (* -> *) -> * -> * where 302 | TermME :: (El lang langs, EvalME lang) 303 | => LangSing lang 304 | -> Repr lang langs e a 305 | -> TermME langs e a 306 | 307 | termME :: (El lang langs, ISing lang, EvalME lang) 308 | => Repr lang langs e a -> TermME langs e a 309 | termME = TermME sing 310 | 311 | -- ** Modular Evaluation Implementation (Boring) 312 | data instance Repr ArithME langs e a where 313 | LitME :: Int -> Repr ArithME langs e Int 314 | AddME :: TermME langs e Int 315 | -> TermME langs e Int 316 | -> Repr ArithME langs e Int 317 | 318 | data instance Repr FancyME langs e a where 319 | FancyOpME :: TermME langs e Int 320 | -> Repr FancyME langs e Int 321 | 322 | -- ** Modular Implementation 323 | 324 | instance EvalME ArithME where 325 | evalME _ (LitME x) = x 326 | evalME k (AddME x y) = k x + k y 327 | 328 | instance EvalME FancyME where 329 | evalME k (FancyOpME x) = k x + 42 330 | 331 | -- ** Modular Evaluation 332 | type MyLangME = [ArithME, FancyME] 333 | 334 | runEvalME :: (forall e. TermME MyLangME e a) -> a 335 | runEvalME t = go t 336 | where go :: TermME MyLangME Identity a -> a 337 | go (TermME _ x) = evalME go x 338 | 339 | testSumME ::TermME MyLangME e Int 340 | testSumME = termME (AddME (termME (LitME 2)) 341 | (termME (LitME 3))) 342 | 343 | -- #+BEGIN_EXAMPLE 344 | -- λ> runEvalME testSumME 345 | -- 5 346 | -- #+END_EXAMPLE 347 | 348 | -- ** Finally Initial 349 | -- *** evalME? I'll eval you! 350 | data LangFI = ArithFI | FancyFI 351 | 352 | type family Finally (l :: k) (e :: * -> *) :: Constraint 353 | 354 | class EvalFI (lang :: LangFI) where 355 | evalFI :: Finally lang e 356 | => (forall a. TermFI langs e a -> a) 357 | -> Repr lang langs e r -> e r 358 | 359 | -- ** Finally Terms (Boring) 360 | data TermFI :: [LangFI] -> (* -> *) -> * -> * where 361 | TermFI :: (El lang langs, EvalFI lang, Finally lang e) 362 | => LangSing lang 363 | -> Repr lang langs e a 364 | -> TermFI langs e a 365 | 366 | -- ** Finally Helper :noexport: 367 | termFI :: (El lang langs, ISing lang, EvalFI lang, 368 | Finally lang e) 369 | => Repr lang langs e a -> TermFI langs e a 370 | termFI = TermFI sing 371 | 372 | -- ** Finally Sub-languages (Boring) 373 | data instance Repr ArithFI langs e a where 374 | LitFI :: Int -> Repr ArithFI langs e Int 375 | AddFI :: TermFI langs e Int 376 | -> TermFI langs e Int 377 | -> Repr ArithFI langs e Int 378 | 379 | data instance Repr FancyFI langs e a where 380 | FancyOpFI :: TermFI langs e Int 381 | -> Repr FancyFI langs e Int 382 | 383 | -- ** Final Evaluation 384 | -- *** Oh right, we defined these a long time ago! 385 | type instance Finally ArithFI e = ArithF e 386 | 387 | instance EvalFI ArithFI where 388 | evalFI _ (LitFI x) = lit x 389 | evalFI k (AddFI x y) = add (lit (k x)) (lit (k y)) 390 | 391 | type instance Finally FancyFI e = 392 | (ArithF e, FancyF e) 393 | 394 | instance EvalFI FancyFI where 395 | evalFI k (FancyOpFI x) = fancyOp (lit (k x)) 396 | 397 | -- ** AllFinal :noexport: 398 | type family AllFinal langs e :: Constraint where 399 | AllFinal '[] e = () 400 | AllFinal (l ': ls) e = (Finally l e, AllFinal ls e) 401 | 402 | -- ** Interpreting Finally Initial 403 | type MyLangFI = [ ArithFI, FancyFI ] 404 | 405 | runEvalFI :: (forall e. AllFinal MyLangFI e 406 | => TermFI MyLangFI e a) 407 | -> a 408 | runEvalFI t = go t 409 | where go :: TermFI MyLangFI Identity b -> b 410 | go (TermFI _ x) = runIdentity (evalFI go x) 411 | 412 | -- ** Finally Initial testSum 413 | testSumFI :: (El ArithFI langs, ArithF e) 414 | => TermFI langs e Int 415 | testSumFI = termFI (AddFI (termFI (LitFI 2)) 416 | (termFI (LitFI 3))) 417 | 418 | -- #+BEGIN_EXAMPLE 419 | -- λ> runEvalFI testSumFI :: Int 420 | -- 5 421 | -- #+END_EXAMPLE 422 | 423 | -- ** Partially Tagless 424 | data LangPF = ArithPF | FancyPF | AbsPF 425 | 426 | class EvalPF (lang :: LangPF) where 427 | evalPF :: (El lang langs, Finally lang e) 428 | => (forall a. TermPF langs e a -> e a) 429 | -> Repr lang langs e r -> e r 430 | 431 | -- ** Potentially Partial Evaluation 432 | class PEval (lang :: LangPF) where 433 | pevalPF :: (El lang langs, 434 | Finally lang (TermPF langs e)) 435 | => (forall a. TermPF langs (TermPF langs e) a 436 | -> TermPF langs e a) 437 | -> Repr lang langs (TermPF langs e) r 438 | -> TermPF langs e r 439 | default pevalPF 440 | :: (El lang langs, EvalPF lang, 441 | Finally lang (TermPF langs e)) 442 | => (forall a. TermPF langs (TermPF langs e) a 443 | -> TermPF langs e a) 444 | -> Repr lang langs (TermPF langs e) r 445 | -> TermPF langs e r 446 | pevalPF = evalPF 447 | 448 | -- ** Terms Look the Same 449 | data TermPF :: [LangPF] -> (* -> *) -> * -> * where 450 | TermPF :: (El lang langs, EvalPF lang, PEval lang, 451 | Finally lang e ) 452 | => LangSing lang 453 | -> Repr lang langs e a 454 | -> TermPF langs e a 455 | 456 | -- ** Term Helper :noexport: 457 | termPF :: (El lang langs, ISing lang, EvalPF lang, 458 | PEval lang, Finally lang e) 459 | => Repr lang langs e a -> TermPF langs e a 460 | termPF = TermPF sing 461 | 462 | -- ** Term Data Types Look the Same 463 | data instance Repr ArithPF langs e a where 464 | LitPF :: Int -> Repr ArithPF langs e Int 465 | AddPF :: TermPF langs e Int 466 | -> TermPF langs e Int 467 | -> Repr ArithPF langs e Int 468 | 469 | -- ** Terms as Finally Tagless Backends 470 | instance (El ArithPF langs, Finally ArithPF e) 471 | => ArithF (TermPF langs e) where 472 | lit = termPF . LitPF 473 | add x y = termPF (AddPF x y) 474 | 475 | -- ** Fancy Terms :noexport: 476 | data instance Repr FancyPF langs e a where 477 | FancyOpPF :: TermPF langs e Int 478 | -> Repr FancyPF langs e Int 479 | 480 | instance (El FancyPF langs, El ArithPF langs, 481 | Finally FancyPF e) 482 | => FancyF (TermPF langs e) where 483 | fancyOp = termPF . FancyOpPF 484 | 485 | -- ** Evaluation... still Final 486 | type instance Finally ArithPF e = ArithF e 487 | 488 | instance EvalPF ArithPF where 489 | evalPF _ (LitPF x) = lit x 490 | evalPF k (AddPF x y) = add (k x) (k y) 491 | 492 | -- ** Partial Evaluation 493 | -- *** /Not Boring/ 494 | pattern AsLit x <- TermPF SArithPF (LitPF x) 495 | 496 | litPF :: (ArithF e, El ArithPF langs) 497 | => Int -> TermPF langs e Int 498 | litPF = termPF . LitPF 499 | 500 | instance PEval ArithPF where 501 | pevalPF _ (LitPF x) = lit x 502 | pevalPF k (AddPF x y) = 503 | case (k x, k y) of 504 | (AsLit x', AsLit y') -> litPF $ x' + y' 505 | (x', y') -> add x' y' 506 | 507 | -- ** Partially Evaluated Code Generation :noexport: 508 | type instance Finally FancyPF e = 509 | (ArithF e, FancyF e) 510 | 511 | instance EvalPF FancyPF where 512 | evalPF k (FancyOpPF x) = fancyOp (k x) 513 | 514 | -- ** Bringing Lambda Back 515 | data instance Repr AbsPF langs e a where 516 | LamPF :: (TermPF langs e a -> TermPF langs e b) 517 | -> Repr AbsPF langs e (a -> b) 518 | AppPF :: TermPF langs e (a -> b) 519 | -> TermPF langs e a 520 | -> Repr AbsPF langs e b 521 | VarPF :: e a -> Repr AbsPF langs e a 522 | 523 | type instance Finally AbsPF e = AbsF e 524 | 525 | -- ** Evaluation 526 | instance (El AbsPF langs, AbsF e) 527 | => AbsF (TermPF langs e) where 528 | lam = termPF . LamPF 529 | app f = termPF . AppPF f 530 | 531 | instance EvalPF AbsPF where 532 | evalPF k (LamPF f) = lam $ k . f . termPF . VarPF 533 | evalPF _ (VarPF x) = x 534 | evalPF k (AppPF f x) = app (k f) (k x) 535 | 536 | -- ** Applied Haskell 537 | pattern AsLam x <- TermPF SAbsPF (LamPF x) 538 | 539 | instance PEval AbsPF where 540 | pevalPF k (AppPF f x) = case (k f, k x) of 541 | (AsLam f', x'@(AsLit _)) -> f' x' 542 | (f', x') -> app f' x' 543 | pevalPF k x = evalPF k x 544 | 545 | -- ** Simplify, man 546 | partialEval :: AllFinal MyLangPF e 547 | => (forall f. AllFinal MyLangPF f 548 | => TermPF MyLangPF f a) 549 | -> TermPF MyLangPF e a 550 | partialEval t = go t 551 | where go :: TermPF langs (TermPF langs e) a 552 | -> TermPF langs e a 553 | go (TermPF _ x) = pevalPF go x 554 | 555 | -- ** Evaluating Partially Final 556 | type MyLangPF = [ ArithPF, FancyPF, AbsPF ] 557 | 558 | runEvalPF :: (forall e. AllFinal MyLangPF e 559 | => TermPF MyLangPF e a) 560 | -> a 561 | runEvalPF t = runIdentity (go t) 562 | where go :: TermPF langs Identity b -> Identity b 563 | go (TermPF _ x) = evalPF go x 564 | 565 | -- *** Remember testSum? 566 | -- #+BEGIN_EXAMPLE 567 | -- λ> runEvalPF testSum :: Int 568 | -- 5 569 | -- #+END_EXAMPLE 570 | 571 | -- ** Remove Tags 572 | -- *** evaluate :: Initial -> Final 573 | i2f :: TermPF langs e a -> e a 574 | i2f (TermPF _ x) = evalPF i2f x 575 | 576 | -- ** Let 'Er Rip! 577 | 578 | testProg :: (AbsF e, ArithF e) => e (Int -> Int) 579 | testProg = lam $ \x -> add x (add (lit 2) (lit 3)) 580 | 581 | -- #+BEGIN_EXAMPLE 582 | -- λ> putStrLn $ getCode testProg 1 583 | -- (\x_1 -> (x_1 + (2 + 3))) 584 | -- #+END_EXAMPLE 585 | 586 | -- ** FINALLY! 587 | 588 | peCode :: Code (Int -> Int) 589 | peCode = i2f (partialEval testProg) 590 | 591 | -- #+BEGIN_EXAMPLE 592 | -- λ> putStrLn $ getCode peCode 1 593 | -- (\x_1 -> (x_1 + 5)) 594 | -- #+END_EXAMPLE 595 | 596 | -- ** Reduce 'Em If You Got 'Em 597 | -- :PROPERTIES: 598 | -- :BEAMER_act: [<+->] 599 | -- :END: 600 | 601 | -- *** 602 | testApp :: (AbsF e, ArithF e) => e Int 603 | testApp = app (lam $ \x -> add x x) (lit 21) 604 | 605 | -- #+BEGIN_EXAMPLE 606 | -- λ> putStrLn $ getCode testApp 1 607 | -- ((\x_1 -> (x_1 + x_1)) 21) 608 | -- #+END_EXAMPLE 609 | 610 | -- *** 611 | peApp :: Code Int 612 | peApp = i2f (partialEval testApp) 613 | 614 | -- #+BEGIN_EXAMPLE 615 | -- λ> putStrLn $ getCode peApp 1 616 | -- 42 617 | -- #+END_EXAMPLE 618 | 619 | -- ** An Emulator in an Optimizer 620 | instance PEval FancyPF where 621 | pevalPF k (FancyOpPF x) = case k x of 622 | AsLit x' -> litPF . runIdentity $ 623 | fancyOp (lit x') 624 | x' -> fancyOp x' 625 | 626 | 627 | -- ** Calling the Hardware SDK 628 | testFancy :: (AbsF e, ArithF e, FancyF e) 629 | => e (Int -> Int) 630 | testFancy = lam $ \x -> 631 | add x (fancyOp (add (lit 5) (lit 10))) 632 | -- #+BEGIN_EXAMPLE 633 | -- λ> putStrLn $ getCode testFancy 1 634 | -- (\x_1 -> (x_1 + (hardwareOperation (5 + 10)))) 635 | -- #+END_EXAMPLE 636 | 637 | -- ** Emulated Hardware 638 | peFancy :: Code (Int -> Int) 639 | peFancy = i2f (partialEval testFancy) 640 | 641 | -- #+BEGIN_EXAMPLE 642 | -- λ> putStrLn $ getCode peFancy 1 643 | -- (\x_1 -> (x_1 + 57)) 644 | -- #+END_EXAMPLE 645 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Selected source files from the March 2015 Boston Haskell talk "Framing 2 | the Discussion with EDSLs". The Haskell source code for the iterations 3 | of designing an EDSL is provided, along with the exported PDF slides 4 | of that code. 5 | 6 | A [video](https://youtu.be/_KioQRICpmo) of the talk is also available. 7 | -------------------------------------------------------------------------------- /edsl.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/acowley/BostonHaskell2015/ec9f1a257f013f28978f0ec4e18e0b6ee817f542/edsl.pdf --------------------------------------------------------------------------------