{-# LANGUAGE TypeFamilies, EmptyDataDecls, TypeOperators #-}{-# LANGUAGE FlexibleInstances #-}-- | Embedding a higher-order domain-specific language (simply-typed-- lambda-calculus with constants) with a selectable evaluation order:-- Call-by-value, call-by-name, call-by-need in the same Final Tagless framework---- <http://okmij.org/ftp/tagless-final/tagless-typed.html#call-by-any>--moduleLanguage.CBwhereimportData.IORefimportControl.MonadimportControl.Monad.Trans-- | Our EDSL is typed. EDSL types are built from the following two-- type constructors:dataIntTdataa:->binfixr5:->-- | We could have used Haskell's type Int and the arrow -> constructor.-- We would like to emphasize however that EDSL types need not be identical-- to the host language types. To give the type system to EDSL, we merely-- need `labels' -- which is what IntT and :-> are---- The (higher-order abstract) syntax of our DSLclassEDSLexpwherelam::(expa->expb)->exp(a:->b)app::exp(a:->b)->expa->expbint::Int->expIntT-- Integer literaladd::expIntT->expIntT->expIntTsub::expIntT->expIntT->expIntT-- | A convenient abbreviationlet_::EDSLexp=>expa->(expa->expb)->expblet_xy=(lamy)`app`x-- | A sample EDSL termt::EDSLexp=>expIntTt=(lam$\x->let_(x`add`x)$\y->y`add`y)`app`int10-- | Interpretation of EDSL types as host language types-- The type interpretation function Sem is parameterized by 'm',-- which is assumed to be a Monad.typefamilySem(m::*->*)a::*typeinstanceSemmIntT=InttypeinstanceSemm(a:->b)=m(Semma)->m(Semmb)-- | Interpretation of EDSL expressions as values of the host language (Haskell)-- An EDSL expression of the type a is interpreted as a Haskell value-- of the type S l m a, where m is a Monad (the parameter of the interpretation)-- and l is the label for the evaluation order (one of Name, Value, or Lazy).-- (S l m) is not quite a monad -- only up to the Sem interpretationnewtypeSlma=S{unS::m(Semma)}-- | Call-by-name--dataNameinstanceMonadIOm=>EDSL(SNamem)whereint=S.returnaddxy=S$doa<-unSxb<-unSyliftIO$putStrLn"Adding"return(a+b)subxy=S$doa<-unSxb<-unSyliftIO$putStrLn"Subtracting"return(a-b)lamf=S.return$(unS.f.S)appxy=S$unSx>>=($(unSy))-- TestsrunName::SNamema->m(Semma)runNamex=unSx-- | Evaluating:---- > t = (lam $ \x -> let_ (x `add` x)-- > $ \y -> y `add` y) `app` int 10---- The addition (x `add` x) is performed twice because y is bound-- to a computation, and y is evaluated twicet0SN=runNamet>>=print{-
Adding
Adding
Adding
40
-}-- A more elaborate examplet1::EDSLexp=>expIntTt1=(lam$\x->let_(x`add`x)$\y->lam$\z->z`add`(z`add`(y`add`y)))`app`(int10`sub`int5)`app`(int20`sub`int10)t1SN=runNamet1>>=print{-
*CB> t1SN
Subtracting
Subtracting
Subtracting
Subtracting
Adding
Subtracting
Subtracting
Adding
Adding
Adding
Adding
40
-}-- | A better examplet2::EDSLexp=>expIntTt2=(lam$\z->lam$\x->let_(x`add`x)$\y->y`add`y)`app`(int100`sub`int10)`app`(int5`add`int5)-- | The result of subtraction was not needed, and so it was not performed-- | OTH, (int 5 `add` int 5) was computed four timest2SN=runNamet2>>=print{-
*CB> t2SN
Adding
Adding
Adding
Adding
Adding
Adding
Adding
40
-}-- Call-by-valuedataValue-- | We reuse most of EDSL (S Name) except for lamvn::SValuemx->SNamemxvn=S.unSnv::SNamemx->SValuemxnv=S.unSinstanceMonadIOm=>EDSL(SValuem)whereint=nv.intaddxy=nv$add(vnx)(vny)subxy=nv$sub(vnx)(vny)appxy=nv$app(vnx)(vny)-- This is the only difference between CBN and CBV:-- lam first evaluates its argument, no matter what-- This is the definition of CBV after alllamf=S.return$(\x->x>>=unS.f.S.return)runValue::SValuema->m(Semma)runValuex=unSx-- We now evaluate the previously written tests t, t1, t2-- under the new interpretationt0SV=runValuet>>=print{-
*CB> t0SV
Adding
Adding
40
-}t1SV=runValuet1>>=print{-
*CB> t1SV
Subtracting
Adding
Subtracting
Adding
Adding
Adding
40
-}-- Although the result of subs-traction was not needed, it was still performed-- OTH, (int 5 `add` int 5) was computed only oncet2SV=runValuet2>>=print{-
*CB> t2SV
Subtracting
Adding
Adding
Adding
40
-}-- Call-by-needshare::MonadIOm=>ma->m(ma)sharem=dor<-liftIO$newIORef(False,m)letac=do(f,m)<-liftIO$readIORefriffthenmelsedov<-mliftIO$writeIORefr(True,returnv)returnvreturnacdataLazy-- | We reuse most of EDSL (S Name) except for lamln::SLazymx->SNamemxln=S.unSnl::SNamemx->SLazymxnl=S.unSinstanceMonadIOm=>EDSL(SLazym)whereint=nl.intaddxy=nl$add(lnx)(lny)subxy=nl$sub(lnx)(lny)appxy=nl$app(lnx)(lny)-- This is the only difference between CBN and CBNeed-- lam shares its argument, no matter what-- This is the definition of CBNeed after alllamf=S.return$(\x->sharex>>=unS.f.S)runLazy::SLazyma->m(Semma)runLazyx=unSx-- We now evaluate the previously written tests t, t1, t2-- under the new interpretation-- | Here, Lazy is just as efficient as CBVt0SL=runLazyt>>=print{-
*CB> t0SL
Adding
Adding
40
-}-- | Dittot1SL=runLazyt1>>=print{-
*CB> t1SL
Subtracting
Subtracting
Adding
Adding
Adding
Adding
40
-}-- | Now, Lazy is better than both CBN and CBV: subtraction was not needed,-- and it was not performed.-- All other expressions were needed, and evaluated once.t2SL=runLazyt2>>=print{-
*CB> t2SL
Adding
Adding
Adding
40
-}