Syntax.hs

{-# 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