Added a newtype wrapper.

And threw in ConstraintKinds for fun.

Main.hs

@@ -1,8 +1,7 @@
 import Moiell
 import Moiell.MonadInstance
 import Moiell.Semantics
-import Moiell.CPS
-import Moiell.JS
+-- import Moiell.JS
 import Moiell.Serialize
 
 main :: IO ()
@@ -14,17 +13,11 @@ r s = putStr $ run (compileString s :: M Comp)
 f :: String -> IO ()
 f n = (compileFile ("examples/" ++ n ++ ".moi") :: IO (M Comp)) >>= putStr . run
 
-cr :: String -> IO ()
-cr s = putStr $ run (compileString s :: M CPS)
-
-cf :: String -> IO ()
-cf n = (compileFile ("examples/" ++ n ++ ".moi") :: IO (M CPS)) >>= putStr . run
-
-jr :: String -> IO ()
-jr s = putStrLn $ run (compileString s :: JS)
-
-jf :: String -> IO ()
-jf n = (compileFile ("examples/" ++ n ++ ".moi") :: IO JS) >>= putStrLn . run
+-- jr :: String -> IO ()
+-- jr s = putStrLn $ run (compileString s :: JS)
+-- 
+-- jf :: String -> IO ()
+-- jf n = (compileFile ("examples/" ++ n ++ ".moi") :: IO JS) >>= putStrLn . run
 
 dr :: String -> IO ()
 dr s = putStrLn $ run (compileString s :: Src)

Moiell/MonadInstance.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, UndecidableInstances #-}
 module Moiell.MonadInstance (
     module Moiell.Class
   , module MonadLibSplit
@@ -19,7 +19,7 @@ import Data.Foldable (foldMap)
 import Data.Maybe (listToMaybe)
 import qualified Data.Map as Map
 
-type M m = m (Value m)
+newtype M m = M { getM :: m (Value m) }
 
 type TIdent       = String
 type TException m = Value m
@@ -34,24 +34,23 @@ inAttr, outAttr :: String
 inAttr  = "_"
 outAttr = "()"
 
-class    (RunMonadPlus m, RunReaderM m (TReader m), RunExceptionM m (Value m), RunWithEnv m) => MoiellMonad m
-instance (RunMonadPlus m, RunReaderM m (TReader m), RunExceptionM m (Value m), RunWithEnv m) => MoiellMonad m
+type MoiellMonad m = (RunMonadPlus m, RunReaderM m (TReader m), RunExceptionM m (Value m), RunWithEnv m)
 
 instance MoiellMonad m => Moiell (M m) where
 
-  urObject = return.O $ Ur
+  urObject = M . return . O $ Ur
 
   -- object :: M m -> CompMap -> CompMap -> M m -> M m
-  object parComp attrsMap _ content = do
+  object (M parComp) attrsMap _ (M content) = M $ do
     val <- parComp
     env <- ask
     case val of
-      O par -> return.O $ setAttr outAttr content $ Object par attrsMap env
+      O par -> return . O $ setAttr outAttr content $ Object par attrsMap env
       x     -> fail ("Cannot extend from a non-object: " ++ show x)
 
-  attrib = return . A
-  string = return . S
-  number = return . N
+  attrib = M . return . A
+  string = M . return . S
+  number = M . return . N
 
   builtIns = Map.fromList 
     [ ("+", mkBinOp (+))
@@ -73,7 +72,7 @@ instance MoiellMonad m => Moiell (M m) where
     ]
 
   -- apply :: M m -> M m -> M m
-  apply fs xs = do
+  apply (M fs) (M xs) = M $ do
     f <- fs
     case f of
 
@@ -90,42 +89,42 @@ instance MoiellMonad m => Moiell (M m) where
       v     -> fail ("Cannot apply a literal value: " ++ show v)
 
   -- split :: M m -> (M m -> M m -> M m) -> M m -> M m
-  split emptyC splitC c = msplit c >>= maybe emptyC (\(h, t) -> splitC (return h) t)
+  split emptyC splitC (M c) = M $ msplit c >>= maybe (getM emptyC) (\(h, t) -> getM $ splitC (M (return h)) (M t))
 
-  throw e = (e >>= raise) >> mzero
-  c `catch` h = try c >>= either (apply h . return) return
-  fatal = fail
+  throw (M e) = M $ (e >>= raise) >> mzero
+  M c `catch` h = M $ try c >>= either (getM . apply h . M . return) return
+  fatal = M . fail
 
-  this = do
+  this = M $ do
     env <- ask
-    return.O $ head env
+    return . O $ head env
 
-  inParent c = do
+  inParent (M c) = M $ do
     env <- ask
     local (tail env) c
 
 
   -- run :: M m -> String
-  run = showResult . runWithEnv globalObject
+  run = showResult . runWithEnv globalObject . getM
 
 instance MoiellMonad m => Monoid (M m) where
-  mempty = mzero
-  mappend = mplus
+  mempty = M mzero
+  M a `mappend` M b = M $ mplus a b
 
 class RunWithEnv m where
-  runWithEnv :: Object m -> M m -> TResult m
+  runWithEnv :: Object m -> m (Value m) -> TResult m
 
 
-evalAttr :: MoiellMonad m => TIdent -> Object m -> M m
+evalAttr :: MoiellMonad m => TIdent -> Object m -> m (Value m)
 evalAttr attrName obj = lookupAttr attrName obj obj
 
-lookupAttr :: MoiellMonad m => TIdent -> Object m -> Object m -> M m
+lookupAttr :: MoiellMonad m => TIdent -> Object m -> Object m -> m (Value m)
 lookupAttr attrName _    Ur = fail ("Could not find attribute: " ++ attrName)
-lookupAttr attrName orig obj = maybe (lookupAttr attrName orig $ parent obj) (local (orig : oEnv obj)) $ 
+lookupAttr attrName orig obj = maybe (lookupAttr attrName orig $ parent obj) (local (orig : oEnv obj) . getM) $ 
   Map.lookup attrName $ attrs obj
 
-setAttr :: MoiellMonad m => TIdent -> M m -> Object m -> Object m
-setAttr attrName attrValue obj = obj{ attrs = Map.insert attrName attrValue $ attrs obj }
+setAttr :: MoiellMonad m => TIdent -> m (Value m) -> Object m -> Object m
+setAttr attrName attrValue obj = obj{ attrs = Map.insert attrName (M attrValue) $ attrs obj }
 
 
 toDouble :: MoiellMonad m => Value m -> m Double
@@ -138,16 +137,16 @@ toString (S s) = return s
 toString v     = return $ show v
 
 mkFun :: MoiellMonad m => (Value m -> m a) -> (a -> M m) -> M m
-mkFun fx f = object urObject Map.empty Map.empty $ this >>= (\(O o) -> evalAttr inAttr o) >>= fx >>= f
+mkFun fx f = object urObject Map.empty Map.empty . M $ getM this >>= (\(O o) -> evalAttr inAttr o) >>= fx >>= getM . f
 
 eachC :: MoiellMonad m => (M m -> M m) -> M m
-eachC f = mkFun return (f . return)
+eachC f = mkFun return (f . M . return)
 
 mkBinOp :: MoiellMonad m => (Double -> Double -> Double) -> M m
 mkBinOp op = mkFun toDouble (\l -> mkFun toDouble (\r -> number $ op l r))
 
 filterN2 :: MoiellMonad m => (Double -> Double -> Bool) -> M m
-filterN2 op = mkFun toDouble (\a -> mkFun toDouble (\b -> if op a b then number a else mzero))
+filterN2 op = mkFun toDouble (\a -> mkFun toDouble (\b -> if op a b then number a else mempty))
 
 charsS :: MoiellMonad m => M m
 charsS = mkFun toString $ foldMap (string . (:[]))

MonadLibSplit.hs

@@ -362,20 +362,20 @@ instance (Monad m)
 instance (MonadPlus m)
            => Alternative (ContT i m)       where (<|>) = mplus; empty = mzero
 
--- instance (MonadPlus m)
---            => Monoid (IdT m a)           where mappend = mplus; mempty = mzero
--- instance (MonadPlus m)
---            => Monoid (ReaderT i m a)     where mappend = mplus; mempty = mzero
--- instance (MonadPlus m)
---            => Monoid (StateT i m a)      where mappend = mplus; mempty = mzero
--- instance (MonadPlus m,Monoid i)
---            => Monoid (WriterT i m a)     where mappend = mplus; mempty = mzero
--- instance (MonadPlus m)
---            => Monoid (ExceptionT i m a)  where mappend = mplus; mempty = mzero
--- instance (Monad m)
---            => Monoid (ChoiceT m a)       where mappend = mplus; mempty = mzero
--- instance (MonadPlus m)
---            => Monoid (ContT i m a)       where mappend = mplus; mempty = mzero
+instance (MonadPlus m)
+           => Monoid (IdT m a)           where mappend = mplus; mempty = mzero
+instance (MonadPlus m)
+           => Monoid (ReaderT i m a)     where mappend = mplus; mempty = mzero
+instance (MonadPlus m)
+           => Monoid (StateT i m a)      where mappend = mplus; mempty = mzero
+instance (MonadPlus m,Monoid i)
+           => Monoid (WriterT i m a)     where mappend = mplus; mempty = mzero
+instance (MonadPlus m)
+           => Monoid (ExceptionT i m a)  where mappend = mplus; mempty = mzero
+instance (Monad m)
+           => Monoid (ChoiceT m a)       where mappend = mplus; mempty = mzero
+instance (MonadPlus m)
+           => Monoid (ContT i m a)       where mappend = mplus; mempty = mzero
 
 
 -- $Monadic_Value_Recursion