module Language.Syntactic.Features.Symbol where
import Data.Typeable
import Data.Hash
import Language.Syntactic
data Sym a
where
Sym :: ConsType a => String -> ConsEval a -> Sym a
instance WitnessCons Sym
where
witnessCons (Sym _ _) = ConsWit
instance ExprEq Sym
where
exprEq (Sym a _) (Sym b _) = a==b
exprHash (Sym name _) = hash name
instance Render Sym
where
renderPart [] (Sym name _) = name
renderPart args (Sym name _)
| isInfix = "(" ++ unwords [a,op,b] ++ ")"
| otherwise = "(" ++ unwords (name : args) ++ ")"
where
[a,b] = args
op = init $ tail name
isInfix
= not (null name)
&& head name == '('
&& last name == ')'
&& length args == 2
instance ToTree Sym
instance Eval Sym
where
evaluate (Sym _ a) = fromEval a
sym0
:: ( Typeable a
, Sym :<: dom
)
=> String
-> a
-> ASTF dom a
sym0 name a = inject (Sym name a)
sym1
:: ( Typeable a
, Sym :<: dom
)
=> String
-> (a -> b)
-> ASTF dom a
-> ASTF dom b
sym1 name f a = inject (Sym name f) :$: a
sym2
:: ( Typeable a
, Typeable b
, Sym :<: dom
)
=> String
-> (a -> b -> c)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
sym2 name f a b = inject (Sym name f) :$: a :$: b
sym3
:: ( Typeable a
, Typeable b
, Typeable c
, Sym :<: dom
)
=> String
-> (a -> b -> c -> d)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
-> ASTF dom d
sym3 name f a b c = inject (Sym name f) :$: a :$: b :$: c
sym4
:: ( Typeable a
, Typeable b
, Typeable c
, Typeable d
, Sym :<: dom
)
=> String
-> (a -> b -> c -> d -> e)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
-> ASTF dom d
-> ASTF dom e
sym4 name f a b c d = inject (Sym name f) :$: a :$: b :$: c :$: d
class IsSymbol expr
where
toSym :: expr a -> Sym a
exprEqFunc :: IsSymbol expr => expr a -> expr b -> Bool
exprEqFunc a b = exprEq (toSym a) (toSym b)
exprHashFunc :: IsSymbol expr => expr a -> Hash
exprHashFunc = exprHash . toSym
renderPartFunc :: IsSymbol expr => [String] -> expr a -> String
renderPartFunc args = renderPart args . toSym
evaluateFunc :: IsSymbol expr => expr a -> a
evaluateFunc = evaluate . toSym