[Haskell-cafe] Re: Designing DSL with explicit sharing [was: I
love?purity, but it's killing me]
Chung-chieh Shan
ccshan at post.harvard.edu
Sun Feb 17 18:08:22 EST 2008
Matthew Naylor <mfn-haskell-cafe at cs.york.ac.uk> wrote in article <20080216105938.GA4052 at pc149.staff.cs.york.ac.uk> in gmane.comp.lang.haskell.cafe:
> > sklansky f [] = []
> > sklansky f [x] = [x]
> > sklansky f xs = left' ++ [ f (last left') r | r <- right' ]
> > where
> > (left, right) = splitAt (length xs `div` 2) xs
> > left' = sklansky f left
> > right' = sklansky f right
> ...
> To write sklansky using your approach, it seems (to me) that the DSL's
> expression type needs to be extended to support lists.
It's actually enough for the -metalanguage- to support lists. You may
not be surprised that the key is to program using continuations (again,
functions just at the metalanguage level, not the object-language
level): "sklansky" should have the (metalanguage) type
Exp repr => (repr a -> repr a -> repr a)
-> [repr a] -> ([repr a] -> repr b) -> repr b
but it would be more convenient to use the continuation monad (from
Control.Monad.Cont) and regard the creation of a name in the object
language as a side effect in the metalanguage.
import DSLSharing (Exp(..), unS)
import Control.Monad.Cont (Cont(Cont), runCont)
sklansky :: Exp repr => (repr a -> repr a -> repr a)
-> [repr a] -> Cont (repr b) [repr a]
sklansky f [] = return []
sklansky f [x] = return [x]
sklansky f xs = do
let (left, right) = splitAt (length xs `div` 2) xs
left' <- sklansky f left
right' <- sklansky f right
fmap (left' ++) (mapM (Cont . let_ . f (last left')) right')
Here's a quick test (I added some whitespace):
*Sklansky> flip unS 0
$ flip runCont id
$ fmap (foldl sub (constant 0))
$ sklansky add
$ map (variable.('x':).show) [0..9]
"let v0 = x0 + x1 in
let v1 = x3 + x4 in
let v2 = x2 + x3 in
let v3 = x2 + v1 in
let v4 = v0 + x2 in
let v5 = v0 + v2 in
let v6 = v0 + v3 in
let v7 = x5 + x6 in
let v8 = x8 + x9 in
let v9 = x7 + x8 in
let v10 = x7 + v8 in
let v11 = v7 + x7 in
let v12 = v7 + v9 in
let v13 = v7 + v10 in
let v14 = v6 + x5 in
let v15 = v6 + v7 in
let v16 = v6 + v11 in
let v17 = v6 + v12 in
let v18 = v6 + v13 in
0 - x0 - v0 - v4 - v5 - v6 - v14 - v15 - v16 - v17 - v18"
--
Edit this signature at http://www.digitas.harvard.edu/cgi-bin/ken/sig
I am a signature virus. Put me in your signature.
More information about the Haskell-Cafe
mailing list