Sharing in a DSL

MyDSL.hs

-- Lee Pike
-- Trying to understand sharing inside a DSL
-- BSD3

module MyDSL where

import Data.List
import Control.Monad.Reader
import Control.Monad.State

-- | A simple language
data Exp =
      Constant Int
    | Variable String -- Free variable
    | Let String Exp Exp -- Let expression
    | Lvar String -- Local variable bound by let exp
    | Add Exp Exp
    | Sub Exp Exp
    | LAdd [Exp] -- Add a list of elements
    deriving (Eq, Ord)

-- Some expressions
a = Add (Constant 10) (Variable "i1") -- 15
b = Sub (Variable "i2") (Constant 2) -- 8
c = Add a b -- 23
d = Add c c -- 46
e = LAdd [d, d] -- 92
f = Let "v" c (Add (Lvar "v") (Lvar "v"))

-- | Show an expression
instance Show Exp where
  show (Constant i) = show i
  show (Variable x) = x
  show (Let x e0 e1) = 
    "let " ++ x ++ " = " ++ show e0 ++ " in " ++ show e1
  show (Lvar x) = x
  show (Add e0 e1) = show e0 ++ " + " ++ show e1
  show (LAdd es) = unwords $ intersperse ("+") (map show es)
  show (Sub e0 e1) = show e0 ++ " - " ++ show e1

type Env = [(String,Int)] 
type LocalVars = [(String,Int)]

-- | Interpret an expression
inter :: Exp -> ReaderT Env (State LocalVars) Int
inter (Constant i) = return i
inter (Variable x) = do
  mp <- ask
  return $ case lookup x mp of
    Nothing -> undefined
    Just i -> i
inter (Let x e0 e1) = do
  i <- inter e0
  st <- get
  put $ (x,i):st
  inter e1  
inter (Lvar v) = do
  st <- get
  return $ case lookup v st of 
    Nothing -> undefined
    Just i -> i
inter (Add e0 e1) = do
  x <- inter e0
  y <- inter e1
  return $ x + y
inter (LAdd es) = do
  foldM (\i e -> inter e >>= \x -> return (x + i)) 0 es
inter (Sub e0 e1) = do
  x <- inter e0
  y <- inter e1
  return $ x - y

-- | Run the interpreter
interpreter :: Exp -> Env -> Int
interpreter exp env = do
  let run = runReaderT (inter exp) env
  evalState run []

-- Returns 46
testInter :: Int
testInter = interpreter f [("i1",5),("i2",10)] 

-- A big expression
big :: Exp
big = big' 5000
  where big' 0 = Constant 0
        big' n = Add (Constant n) (big' (n-1))

-- Repeat the big expression with no sharing and interpret it
slowInterpret :: Int
slowInterpret = interpreter repeatBig []
  where repeatBig = rep' 100
        rep' 0 = big
        rep' n = Add big (rep' (n-1))

-- Repeat the big expression by sharing
fastInterpret :: Int
fastInterpret = interpreter fastBig []
  where fastBig = Let "v" big (repeatLvar 100)
        repeatLvar 0 = Lvar "v"
        repeatLvar n = Add (Lvar "v") (repeatLvar (n-1))