melody (empty) → 0.2

raw patch · 15 files changed

+688/−0 lines, 15 filesdep +HUnitdep +ParsecToolsdep +basesetup-changed

Dependencies added: HUnit, ParsecTools, base, containers, either, lens, melody, mtl, parsec, test-framework, test-framework-hunit

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• melody.cabal +60/−0
• repl/Main.hs +5/−0
• src/Language/Melody.hs +28/−0
• src/Language/Melody/API.hs +32/−0
• src/Language/Melody/Interpret.hs +38/−0
• src/Language/Melody/Interpret/Compile.hs +74/−0
• src/Language/Melody/Interpret/Env.hs +6/−0
• src/Language/Melody/Interpret/Env/Primops.hs +79/−0
• src/Language/Melody/Interpret/Pop.hs +82/−0
• src/Language/Melody/Interpret/Types.hs +44/−0
• src/Language/Melody/Parser.hs +110/−0
• src/Language/Melody/Syntax.hs +101/−0
• test/Main.hs +6/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) <year> <copyright holders>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,60 @@+name:                melody+version:             0.2+synopsis:            A functional scripting language++description:         A scripting language meant to replace+                     shell modeled after Joy.++license:             MIT+license-file:        LICENSE+author:              Danny Gratzer++maintainer:          danny.gratzer@gmail.com++category:            Language++build-type:          Simple++cabal-version:       >=1.10++Library+        hs-source-dirs: src+        ghc-options: -Wall+        exposed-modules:       Language.Melody.Syntax,+                               Language.Melody.Parser,+                               Language.Melody.Interpret,+                               Language.Melody.API,+                               Language.Melody.Interpret.Env,+                               Language.Melody.Interpret.Pop,+                               Language.Melody.Interpret.Types,+                               Language.Melody.Interpret.Compile,+                               Language.Melody.Interpret.Env.Primops+                               Language.Melody+        build-depends:       base >=4.6 && <4.7,+                             lens > 3.8,+                             mtl == 2.*,+                             containers == 0.5.*,+                             parsec == 3.*,+                             either > 2.9,+                             ParsecTools+        default-language:    Haskell2010++executable imelody+  main-is:             Main.hs+  hs-source-dirs:      repl+  ghc-options:         -Wall+  build-depends:       base >=4.6 && <4.7, melody+  default-language:    Haskell2010+++Test-Suite test-melody+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     test+  build-depends:      base >=4.6 && <4.7,+                      test-framework,+                      test-framework-hunit,+                      containers,+                      mtl,+                      HUnit,+                      melody

@@ -0,0 +1,5 @@+module Main where+import qualified Language.Melody as M++main :: IO ()+main = M.main

@@ -0,0 +1,28 @@+module Language.Melody where+import Language.Melody.Parser+import Language.Melody.Interpret+import Control.Monad+import Control.Monad.Error+import System.Environment+import System.IO++repl :: Melody+repl = forever . flip catchError (liftIO . print) $ do+  liftIO $ putStr ">>> " >> hFlush stdout+  l <- parseMelody `fmap` liftIO getLine+  case l of+    Left err -> liftIO $ print err+    Right m  -> eval m++evalFile :: String -> Melody+evalFile f = do+  res <- liftIO $ parseSrcFile f+  case res of+    Left err        -> liftIO $ print err+    Right toplevels -> mapM_ eval toplevels++main :: IO ()+main = do+  args <- getArgs+  void . runMelody $ mapM_ evalFile args >> repl+       

@@ -0,0 +1,32 @@+module Language.Melody.API (runExpr, runTopLevel, runFile) where+import Text.Parsec+import Language.Melody.Interpret.Types+import Language.Melody.Interpret+import Language.Melody.Parser+import Language.Melody.Syntax+import Control.Monad.Trans.Either++data Error = Parser ParseError | Eval EvalError+           deriving (Show)++type Stack = [Expr Compiled]++type MelodyResult = IO (Either Error Stack)++liftError :: (e -> Error) -> Either e a -> Either Error a+liftError f = either (Left . f) Right++run :: [TopLevel] -> MelodyResult+run = fmap (liftError Eval) . runMelody . mapM_ eval++liftParser :: (String -> Either ParseError a) -> String -> EitherT Error IO a+liftParser p = hoistEither . liftError Parser . p++liftIOParser :: (String -> IO (Either ParseError a)) -> String -> EitherT Error IO a+liftIOParser p = EitherT . fmap (liftError Parser) . p++runExpr, runTopLevel, runFile :: String -> MelodyResult+runExpr s     = runEitherT $ liftParser   parseMelodyExpr s >>= EitherT . run . (:[]) . Exec+runTopLevel t = runEitherT $ liftParser   parseMelody t     >>= EitherT . run . (:[])+runFile f     = runEitherT $ liftIOParser parseSrcFile f    >>= EitherT . run+

@@ -0,0 +1,38 @@+{-# LANGUAGE TupleSections #-}+module Language.Melody.Interpret (eval, runMelody, Melody) where+import Control.Lens+import Data.List (nub)+import Control.Monad.Error+import Language.Melody.Interpret.Env+import Language.Melody.Interpret.Types+import Language.Melody.Interpret.Compile+import Language.Melody.Interpret.Pop+import Language.Melody.Syntax+import Control.Monad.Reader+import qualified Data.Map as M++-- | Generate constructors for a given type. This creates+-- a new word for each constructor+generateConstrs :: TypeName -> [(Constructor, Int)] -> [(String, Melody)]+generateConstrs t = map makeConstr+  where makeConstr (name, arity) = (name, replicateM arity pop >>= push . Boxed t name)++-- | Run a given expression in an environment with no local variables+emptyEnv :: Melody -> Melody+emptyEnv = local (const M.empty)++-- | Evaluate a @TopLevel@. If it is an expression it runs it,+-- otherwise it generates the appropriate bindings for definitions.+eval :: TopLevel -> Melody+eval (Def nm expr) = env.at nm .= Just (emptyEnv $ compile expr)+eval (Exec expr)   = compile expr+eval (Type t cs)   = assertUnique (map fst cs) >> env %= M.union (M.fromList $ generateConstrs t cs)+  where assertUnique names = when (length names /= length (nub names))+                             . throwError . Misc $ "Constructors are not unique for " ++ t+eval (MultiDef t) = multi.at t .= Just []+eval (MultiExt t args body) = multi.at t._Just %= (:) (args, emptyEnv $ compile body)++-- | Turn a @Melody@ expression into an @IO@ expression+runMelody :: Melody -> IO (Either EvalError [Expr Compiled])+runMelody = getStack $ unwrapMelody (M.fromList []) defaultEnv+  where getStack = mapped.mapped._Right %~ view stack

@@ -0,0 +1,74 @@+module Language.Melody.Interpret.Compile (compile) where+import Language.Melody.Syntax+import Language.Melody.Interpret.Types+import Language.Melody.Interpret.Pop+import Control.Monad.Error+import Control.Monad.Reader+import Control.Lens+import Control.Applicative+import qualified Data.Map as M+import Data.Maybe+++resolve :: [([TypeName], Melody)] -> MelodyM (Maybe Melody)+resolve cs = fmap snd . foldr choose Nothing <$> filterM matches cs+  where matches (ts, _) = do+          s <- map typeName <$> use stack+          return $ length s >= length ts && s <<: ts+        choose (t1, body1) (Just (t2, body2)) | t1 <<: t2  = Just (t1, body1)+                                              | t2 <<: t1  = Just (t2, body2)+                                              | otherwise = Nothing+        choose t  Nothing   = Just t+        t1 <<: t2 = all (uncurry (<:)) $ zip t1 t2+        +-- | Bind a list of expressions into a closure+addClosure :: Expr NotCompiled -> MelodyM (Expr NotCompiled)+addClosure body = (Func body . Just) <$> ask++-- | Ask whether a word is in a closure, inlining it+-- if it is.+inlineClosedWord :: String -> MelodyM (Expr NotCompiled)+inlineClosedWord w = maybe (Word w) id . M.lookup w <$> ask++-- | Attach a closure to a function without+-- and inline a closed word running and recurses on all+-- other compound structures+close :: Expr NotCompiled -> MelodyM (Expr NotCompiled)+close (Func body Nothing) = addClosure body+close (Word w)            = inlineClosedWord w+close (Dictionary d)      = Dictionary <$> mapM (both close) d+close (List l)            = List <$> mapM close l+close a                   = return a++-- | Resolve a variable name in the current scope+selectVariable :: String -> Melody+selectVariable w = do+  global <- use (env.at w)        -- Global+  mult   <- use (multi.at w) >>= resolving+  loc    <- M.lookup w <$> ask    -- Local+  assertExists $ pushing loc <|> mult <|> global+  where pushing      = fmap push+        resolving    = maybe (return Nothing) id . fmap resolve+        assertExists = fromMaybe . lift . throwError $ NoSuchName w++-- | Compile a group of expressions in order+compileMany :: [Expr NotCompiled] -> Melody+compileMany = mapM_ compile++-- | Bind the list of names to the top items on the stack+addEnv :: [String] -> Melody -> Melody+addEnv names m = do+  vals <- topN (length names)+  local (M.union . M.fromList $ zip names vals) m++-- | Compile a Melody expression.+-- If the expression is a word, than it is evaluated in the+-- current context, otherwise it is pushed on to the stack+compile :: Expr NotCompiled -> Melody+compile (Word w) = selectVariable w+compile (Binding nms exprs) = addEnv nms $ compileMany exprs+compile (Comp es) = compileMany es+compile (Func body Nothing) = addClosure body >>= push+compile (List es) = mapM close es >>= push . List+compile (Dictionary es) = mapM (both close) es >>= push . Dictionary+compile e = push e

@@ -0,0 +1,6 @@+module Language.Melody.Interpret.Env where+import Language.Melody.Interpret.Types+import Language.Melody.Interpret.Env.Primops++defaultEnv :: MelodyState+defaultEnv = primops

@@ -0,0 +1,79 @@+module Language.Melody.Interpret.Env.Primops where+import Language.Melody.Syntax+import Language.Melody.Interpret.Types+import Language.Melody.Interpret.Pop+import Language.Melody.Interpret.Compile+import Control.Monad.Reader+import Control.Applicative+import Control.Lens hiding (cons, uncons)+import qualified Data.Map as M++primops :: MelodyState+primops = MS builtins M.empty []++arith :: (Double -> Double -> Double) -> Melody+arith f = liftM2 f popNum popNum >>= push . NumLit++cons :: Melody+cons = do+  t <- pop+  case t of+    StrLit s       -> pushWith popStr           $ StrLit . (++ s)+    List   l       -> pushWith pop              $ List . (:l)+    Dictionary   d -> pushWith (pop >>= toPair) $ Dictionary . (:d)+    _              -> typeError "cons: Not sequence"+  where toPair (List [a, b]) = return (a, b)+        toPair _             = typeError "cons: Not a list of two elements"+        pushWith f with = f >>= push . with++uncons :: Melody+uncons = do+  expr <- pop+  case expr of+    StrLit (s : ss)        -> pushBoth (StrLit [s]) (StrLit ss)+    List   (l : ll)        -> pushBoth l (List ll)+    Dictionary ((a,b): hh) -> pushBoth (List [a, b]) (Dictionary hh)+    _                      -> typeError "Not sequence"+  where pushBoth a b = push b >> push a++apply :: Melody+apply = do+  (body, clos) <- popFunc+  clos' <- maybe (fail "$: Caught non-closed lambda") return clos+  void . local (M.union clos') $ compile body+    -- Use the closure attached to a function++equals :: Melody+equals = do+  l <- pop+  r <- pop+  when (isOpaque l || isOpaque r) $+    typeError "Comparing Opaques"+  if l == r then true else false+  where true  = void pop+        false = pop <* pop >>= push+        isOpaque (Opaque {}) = True+        isOpaque _           = False+++unbox :: Melody+unbox = popBoxed >>= mapM_ push . reverse . contents+  where contents (_, _, es) = es++builtins :: M.Map String Melody+builtins = M.fromList+           [("pop", void pop),+            ("print", pop >>= liftIO . print),+            ("putStr", popStr >>= liftIO . putStrLn),+            ("+", arith (+)),+            ("-", arith (-)),+            ("/", arith (/)),+            ("*", arith (*)),+            ("dump", use stack >>= liftIO . print),+            ("cons", cons),+            ("uncons", uncons),+            ("$", apply),+            ("no-op", return ()),+            ("=", equals),+            ("unbox", unbox),+            ("typeOf", pop >>= push . StrLit . typeName)]

@@ -0,0 +1,82 @@+module Language.Melody.Interpret.Pop (+  push,+  pop,+  topN,+  popWord,+  popFunc,+  popDict,+  popList,+  popNum,+  popStr,+  popBoxed) where+import Language.Melody.Interpret.Types+import Language.Melody.Syntax+import Control.Monad.Error+import Control.Lens++errorMsg :: String -> Expr Compiled -> MelodyM a+errorMsg s e = throwError . TypeMismatch $ "Expected " ++ s ++ " got " ++ show e++push :: Expr NotCompiled -> Melody+push = (stack %=) . (:)++pop :: MelodyM (Expr Compiled)+pop = do+  h <- use (stack.to headMay)+  case h of+    Just x -> stack %= tail >> return x+    Nothing -> lift . throwError $ UnderflowError "Somewhere"+  where headMay []    = Nothing+        headMay (c:_) = Just c++popWord :: MelodyM String+popWord = do+  h <- pop+  case h of+    Word w -> return w+    e      -> errorMsg "word" e++popFunc :: MelodyM (Expr NotCompiled, Maybe Closure)+popFunc = do+  f <- pop+  case f of+    Func exprs clos -> return (exprs, clos)+    e               -> errorMsg "func" e++popDict :: MelodyM [(Expr Compiled, Expr Compiled)]+popDict = do+  h <- pop+  case h of+    Dictionary d   -> return d+    e              -> errorMsg "hash" e++popList :: MelodyM [Expr Compiled]+popList = do+  h <- pop+  case h of+    List w -> return w+    e      -> errorMsg "list" e++popNum :: MelodyM Double+popNum = do+  h <- pop+  case h of+    NumLit n -> return n+    e        -> errorMsg "num" e++popStr :: MelodyM String+popStr = do+  h <- pop+  case h of+    StrLit n -> return n+    e        -> errorMsg "str" e++popBoxed :: MelodyM (String, String, [Expr Compiled])+popBoxed = do+  b <- pop+  case b of+    Boxed t c es -> return (t, c, es)+    e            -> errorMsg "boxed" e++topN :: Int -> MelodyM [Expr Compiled]+topN = flip replicateM pop

@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+module Language.Melody.Interpret.Types where+import Language.Melody.Syntax+import Control.Monad.Error+import Control.Monad.State+import Control.Monad.Reader+import Control.Lens+import Data.Monoid+import Data.Map(Map, empty, union)++data EvalError = UnderflowError String+               | TypeMismatch String+               | NoSuchName String+               | Misc String+               deriving (Eq, Show)++instance Error EvalError where+  strMsg = Misc+  noMsg  = Misc "Report this error"++++type MelodyM = ReaderT Closure (StateT MelodyState (ErrorT EvalError IO))+-- Since melody is stack based, there's no need for return values+type Melody = MelodyM ()++data MelodyState = MS { _env   :: Map String Melody+                      , _multi :: Map String [([TypeName], Melody)]+                      , _stack :: [Expr Compiled]}++makeLenses ''MelodyState++instance Monoid MelodyState where+  mempty  = MS empty empty []+  mappend (MS env1 multi1 stack1) (MS env2 multi2 stack2) = MS (union env1 env2)+                                                            (union multi1 multi2)+                                                            (stack1 ++ stack2)++unwrapMelody :: Closure -> MelodyState -> Melody -> IO (Either EvalError MelodyState)+unwrapMelody lexVars defaultEnv =+  runErrorT . flip execStateT defaultEnv . flip runReaderT lexVars++typeError :: String -> MelodyM a+typeError = throwError . TypeMismatch

@@ -0,0 +1,110 @@+module Language.Melody.Parser (parseMelody, parseMelodyExpr, parseSrcFile) where+import Language.Melody.Syntax+import Text.Parsec+import Text.Parsec.Numbers+import Text.Parsec.String+import Control.Applicative hiding ((<|>), many)+import Control.Monad (void)++parseId :: Parser String+parseId = many1 . oneOf $ "!@#$&*_-+=<>" ++ ['a'..'z'] ++ ['A' .. 'Z']++parseWord :: Parser (Expr NotCompiled)+parseWord = Word <$> parseId++parseQuotedWord :: Parser (Expr NotCompiled)+parseQuotedWord = noClosFunc <$> (char '\'' *> parseWord)++parseFunc :: Parser (Expr NotCompiled)+parseFunc = noClosFunc <$>+            (char '[' *> spaces *> parseExpr <* spaces <* char ']')++parseList :: Parser (Expr NotCompiled)+parseList = do+  char '(' *> spaces+  exprs <- parseExpr `sepBy` (spaces >> char ';' >> spaces)+  void $ spaces *> char ')'+  return $ List exprs++parseDict :: Parser (Expr NotCompiled)+parseDict = do+  char '(' *> spaces+  exprs <- ((,) <$> parseExpr <*> (sep >> parseExpr))+           `sepBy` (spaces >> char ';' >> spaces)+  void $ spaces >> char ')'+  return $ Dictionary exprs+  where sep = spaces >> string "~>" >> spaces++parseNum :: Parser (Expr NotCompiled)+parseNum = NumLit <$> parseFloat++parseStr :: Parser (Expr NotCompiled)+parseStr = StrLit <$> (char '"' *> many (noneOf "\"") <* char '"')++parseBinding :: Parser (Expr NotCompiled)+parseBinding = do+  char '{' >> spaces+  nms <- parseId `sepBy` spaces+  spaces >> char ',' >> spaces+  exprs <- parseExpr `sepBy` spaces+  void $ spaces >> char '}'+  return $ Binding nms exprs++parseExpr :: Parser (Expr NotCompiled)+parseExpr = do+  e  <- p+  es <- try (p `sepBy1` spaces) <|> return []+  return $ if null es then e else Comp (e:es)+  where p = spaces *>+          (parseWord+          <|> parseQuotedWord+          <|> parseFunc+          <|> try parseList -- Backtracking for dictionaries+          <|> parseDict+          <|> parseNum+          <|> parseStr+          <|> parseBinding)++parseDef :: Parser TopLevel+parseDef = do+         char ':' *> spaces+         Word n <- parseWord+         Def n <$> parseExpr++parseType :: Parser TopLevel+parseType = do+  string "type" *> spaces+  name <- parseId <* spaces+  char '=' *> spaces+  cs       <- constr `sepBy1` (spaces *> char '|' *> spaces)+  return $ Type name cs+  where constr = (,) <$> parseId <*> (spaces *> parseIntegral)++parseMultiDef :: Parser TopLevel+parseMultiDef = do+  string "def" *> spaces+  MultiDef <$> parseId <* spaces++parseMultiExt :: Parser TopLevel+parseMultiExt = do+  string "ext" *> spaces+  MultiExt <$> (parseId <* spaces) <*> types <*> parseExpr+    where types = char '[' *> parseId `sepBy` (spaces *> char ';' <* spaces) <* char ']'++parseTopLevel :: Parser TopLevel+parseTopLevel = spaces *>+                (try parseType+                 <|> try parseMultiDef+                 <|> try parseMultiExt+                 <|> parseDef+                 <|> Exec <$> parseExpr)+                <* spaces <* char '.' <* spaces++parseMelody :: String -> Either ParseError TopLevel+parseMelody = parse parseTopLevel "Melody Parser"++parseMelodyExpr :: String -> Either ParseError (Expr NotCompiled)+parseMelodyExpr = parse parseExpr "Melody Parser"++parseSrcFile :: String -> IO (Either ParseError [TopLevel])+parseSrcFile = parseFromFile (many1 parseTopLevel)

@@ -0,0 +1,101 @@+{-# LANGUAGE EmptyDataDecls #-}+module Language.Melody.Syntax where+import Data.List+import Data.Dynamic (Dynamic)+import Data.Map (Map)++type Closure = Map String (Expr Compiled)++-- | The AST representing Melody's expressions+data MExpr = Word String+             -- ^ The most basic type, represents a variable+           | Func MExpr (Maybe Closure)+             -- ^ An anonymous function, consisting of the expression it contaisn+             -- that it evaluates and the closure it was created in.+           | Dictionary  [(MExpr, MExpr)]+             -- ^ An associative map type+           | List    [MExpr]+             -- ^ A list type+           | NumLit  Double+             -- ^ The only type of numeric literal, a @Double@+           | StrLit  String+             -- ^ The wrapped string representing strings in melody code+           | Binding [String] [MExpr]+             -- ^ A binding expressions binding the list of strings+             -- to values on the stack as variables in the list of expressions.+           | Comp [MExpr]+             -- ^ Represents the composition of several expressions+           | Boxed TypeName Constructor [MExpr]+             -- ^ The representation of product types, consists of a type tag and fields+           | Opaque String Dynamic+             -- ^ An opaque type, such as a filehandle.+             -- It's boxed in dynamic and paired with a description.++instance Eq MExpr where+  (Word w1) == (Word w2) = w1 == w2+  (Func b1 c1) == (Func b2 c2) = b1 == b2 && c1 == c2+  (Dictionary d1) == (Dictionary d2) = d1 == d2+  (List l1) == (List l2) = l1 == l2+  (NumLit d1) == (NumLit d2) = d1 == d2+  (StrLit s1) == (StrLit s2) = s1 == s2+  (Binding nms1 exprs1) == (Binding nms2 exprs2) = nms1 == nms2 && exprs1 == exprs2+  (Comp es1) == (Comp es2) = es1 == es2+  (Boxed t1 c1 e1) == (Boxed t2 c2 e2) = t1 == t2 && c1 == c2 && e1 == e2+  _ == _ = False++data Compiled    -- ^ Has been evaluated, contains no free variables+data NotCompiled -- ^ Raw and unevaluated++-- | A phantom type to represent whether data has been+-- evaluated.+type Expr a = MExpr++instance Show MExpr where+  show (Word w) = w+  show (Func ws _) = "[" ++ show ws ++  "]"+  show (Dictionary d) = "(" ++ concatMap showPair d ++ ")"+    where showPair (k, v) = show k ++ " ~> " ++ show v ++ ", "+  show (List ls) = "(" ++ intercalate " ; " (map show ls) ++ ")"+  show (NumLit n) = show n+  show (StrLit s) = show s+  show (Binding nms exprs) =+    "{" ++ unwords nms ++ "," ++ unwords (map show exprs) ++ "}"+  show (Comp exprs) = unwords . map show $ exprs+  show (Boxed t c vs) = t ++ '.' : c ++ "(" ++ unwords (map show vs) ++ ")"+  show (Opaque desc _) = desc++type Constructor = String+type TypeName        = String+-- | The AST for toplevel forms in Melody programs+data TopLevel = Def String (Expr NotCompiled)+                -- ^ A word definition, dynamically binds+                -- the string to the list of expressions+              | Exec (Expr NotCompiled)+                -- ^ Executes the list of expressions+              | Type TypeName [(Constructor, Int)]+                -- ^ A variant type, associates a typename+                -- @String@ with a list of constructors.+              | MultiDef String+              | MultiExt String [TypeName] (Expr NotCompiled)+              deriving(Eq, Show)++-- | Generate a function with an empty closure.+-- Avoids importing @Data.Map@ everywhere.+noClosFunc :: Expr NotCompiled -> Expr NotCompiled+noClosFunc = flip Func Nothing++typeName :: MExpr -> TypeName+typeName (NumLit {}) = "Num"+typeName (StrLit {}) = "Str"+typeName (Word {})   = "Word"+typeName (Binding {}) = "Binding"+typeName (Boxed t _ _) = t+typeName (List {}) = "List"+typeName (Dictionary {}) = "Dictionary"+typeName (Func {}) = "Func"+typeName (Opaque s _) = s+typeName (Comp {}) = "Comp"++(<:) :: TypeName -> TypeName -> Bool+_ <: "_" = True+a   <: b = a == b

@@ -0,0 +1,6 @@+import Data.Monoid+import Utils+import Eq++main :: IO ()+main = defaultMainWithOpts [equalityTests] mempty