-- | 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" -}