module Language.Syntactic.Features.Symbol where
import Data.Typeable
import Data.Hash
import Data.Proxy
import Language.Syntactic
data Sym ctx a
where
Sym :: (ConsType a, Sat ctx (EvalResult a)) =>
String -> ConsEval a -> Sym ctx a
instance WitnessCons (Sym ctx)
where
witnessCons (Sym _ _) = ConsWit
instance WitnessSat (Sym ctx)
where
type Context (Sym ctx) = ctx
witnessSat (Sym _ _) = Witness'
witnessSatSym :: forall ctx dom a . (Sym ctx :<: dom)
=> Proxy ctx
-> ASTF dom a
-> Maybe (Witness' ctx a)
witnessSatSym ctx = witSym
where
witSym :: (EvalResult b ~ a) => AST dom b -> Maybe (Witness' ctx a)
witSym (prjSym ctx -> Just (Sym _ _)) = Just Witness'
witSym (f :$: _) = witSym f
witSym _ = Nothing
instance ExprEq (Sym ctx)
where
exprEq (Sym a _) (Sym b _) = a==b
exprHash (Sym name _) = hash name
instance Render (Sym ctx)
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 ctx)
instance Eval (Sym ctx)
where
evaluate (Sym _ a) = fromEval a
sym0
:: ( Sat ctx a
, Sym ctx :<: dom
)
=> Proxy ctx
-> String
-> a
-> ASTF dom a
sym0 ctx name a = inject (Sym name a `withContext` ctx)
sym1
:: ( Typeable a
, Sat ctx b
, Sym ctx :<: dom
)
=> Proxy ctx
-> String
-> (a -> b)
-> ASTF dom a
-> ASTF dom b
sym1 ctx name f a = inject (Sym name f `withContext` ctx) :$: a
sym2
:: ( Typeable a
, Typeable b
, Sat ctx c
, Sym ctx :<: dom
)
=> Proxy ctx
-> String
-> (a -> b -> c)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
sym2 ctx name f a b = inject (Sym name f `withContext` ctx) :$: a :$: b
sym3
:: ( Typeable a
, Typeable b
, Typeable c
, Sat ctx d
, Sym ctx :<: dom
)
=> Proxy ctx
-> String
-> (a -> b -> c -> d)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
-> ASTF dom d
sym3 ctx name f a b c = inject (Sym name f `withContext` ctx) :$: a :$: b :$: c
sym4
:: ( Typeable a
, Typeable b
, Typeable c
, Typeable d
, Sat ctx e
, Sym ctx :<: dom
)
=> Proxy ctx
-> String
-> (a -> b -> c -> d -> e)
-> ASTF dom a
-> ASTF dom b
-> ASTF dom c
-> ASTF dom d
-> ASTF dom e
sym4 ctx name f a b c d =
inject (Sym name f `withContext` ctx) :$: a :$: b :$: c :$: d
prjSym :: (Sym ctx :<: sup) =>
Proxy ctx -> sup a -> Maybe (Sym ctx a)
prjSym _ = project
class IsSymbol expr
where
toSym :: expr a -> Sym Poly a
exprEqSym :: IsSymbol expr => expr a -> expr b -> Bool
exprEqSym a b = exprEq (toSym a) (toSym b)
exprHashSym :: IsSymbol expr => expr a -> Hash
exprHashSym = exprHash . toSym
renderPartSym :: IsSymbol expr => [String] -> expr a -> String
renderPartSym args = renderPart args . toSym
evaluateSym :: IsSymbol expr => expr a -> a
evaluateSym = evaluate . toSym