Language.hs

-- | The Language type that is the core of GroteTrap.
module Language.GroteTrap.Language (

  -- * Language
  Language(..),
  
  -- * Operators
  Operator(..),
  Fixity1(..), Fixity2(..),
  isUnary, isBinary, isNary,
  findOperator,

  -- * Functions
  Function(..),
  findFunction,
  function1, function2

  ) where


------------------------------------
-- Language
------------------------------------


-- | Language connects the syntax of identifiers, numbers, operators and functions with their semantics. GroteTrap is able to derive a parser and evaluator from a Language, as well as convert between source text selections and tree selections.
data Language a  =   Language
  { variable     ::  (String -> a)
  , number       ::  (Int -> a)
  , operators    ::  [Operator a]
  , functions    ::  [Function a]
  }


------------------------------------
-- Operators
------------------------------------


-- | Representation of an operator.
data Operator a
  = -- | An operator expecting one operand.
    Unary
    { opSem1        :: a -> a
    , opFixity1     :: Fixity1
    , opPrio        :: Int
    , opToken       :: String
    }
  | -- | An operator expecting two operands.
    Binary
    { opSem2        :: a -> a -> a
    , opFixity2     :: Fixity2
    , opPrio        :: Int
    , opToken       :: String
    }
  | -- | An infix associative operator that chains together an arbitrary number of operands.
    Nary
    { opSemN        :: [a] -> a
    , opSubranges   :: Bool
    , opPrio        :: Int
    , opToken       :: String
    }


-- | Fixity for unary operators.
data Fixity1
  = Prefix  -- ^ The operator is written before its operand.
  | Postfix -- ^ The operator is written after its operand.
  deriving (Show, Enum, Eq)


-- | Fixity for infix binary operators.
data Fixity2
  = InfixL  -- ^ The operator associates to the left.
  | InfixR  -- ^ The operator associates to the right.
  deriving (Show, Enum, Eq)


isUnary, isBinary, isNary   ::  Operator a -> Bool
isUnary   (Unary  _ _ _ _)  =   True
isUnary   _                 =   False
isBinary  (Binary _ _ _ _)  =   True
isBinary  _                 =   False
isNary    (Nary _ _ _ _)    =   True
isNary    _                 =   False


-- | Yields the specified operator in a monad. Fails when there are no operators with the name, or where there are several operators with the name.
findOperator :: Monad m => String -> [Operator a] -> m (Operator a)
findOperator name os = case filter ((== name) . opToken) os of
  []  -> fail ("no operator " ++ name ++ " exists")
  [o] -> return o
  _   -> fail ("several operators " ++ name ++ " exist")


------------------------------------
-- Functions
------------------------------------


-- | Representation of a function.
data Function a = Function
  { fnSem   :: [a] -> a
  , fnName  :: String
  , fnArity :: Int
  }


-- | Lifts a unary function to a 'Function'.
function1 :: (a -> a) -> String -> Function a
function1 f s = Function (\[x] -> f x) s 1


-- | Lifts a binary function to a 'Function'.
function2 :: (a -> a -> a) -> String -> Function a
function2 f s = Function (\[x, y] -> f x y) s 2


-- | Yields the function with the specified name. If there are no functions with the name, or if there are several functions with the name, failure is returned.
findFunction :: Monad m => String -> [Function a] -> m (Function a)
findFunction name fs = case filter ((== name) . fnName) fs of
  []  -> fail ("no function named " ++ name)
  [f] -> return f
  _   -> fail ("duplicate function " ++ name)

{-
semFunction :: Function a -> [a] -> a
semFunction fun args = if arity == length args
  then fnSem args
  else error $ concat ["function ", name, " expects ", show arity, " ", argtext, ", but got ", show $ length args]
  where arity = functionArity fun
        name  = functionName fun
        argtext | arity == 1 = "argument"
                | otherwise  = "arguments"
-}