import Language.Symantic.Lib.Monoid (tyMonoid)
-- * Class 'Sym_Tuple2'
-type instance Sym (Proxy (,)) = Sym_Tuple2
+type instance Sym (,) = Sym_Tuple2
class Sym_Tuple2 term where
tuple2 :: term a -> term b -> term (a, b)
fst :: term (a, b) -> term a
-- Typing
instance FixityOf (,) where
- fixityOf _c = Fixity2 $ infixN (-1)
+ fixityOf _c = Just $ Fixity2 $ infixN (-1)
instance ClassInstancesFor (,) where
proveConstraintFor _ (TyApp _ (TyConst _ _ q) (TyApp _ c a))
| Just HRefl <- proj_ConstKiTy @_ @(,) c
, Gram_Term src ss g
, Inj_Sym ss (,)
) => Gram_Term_AtomsFor src ss g (,) where
- g_term_atomsFor _t =
+ g_term_atomsFor =
-- TODO: proper TupleSections
[ rule "teTuple2_2" $
g_source $ parens $
(\a b src ->
- BinTree2 (BinTree2 (BinTree0 $ Token_Term $ TermVT_CF $ (`setSource` src) $ teTuple2) a) b)
+ BinTree2 (BinTree2 (BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ teTuple2) a) b)
<$> g_term
<* symbol ","
<*> g_term
, rule "teTuple2" $
g_source $
- (\src -> BinTree0 $ Token_Term $ TermVT_CF $ (`setSource` src) $ teTuple2)
+ (\src -> BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ teTuple2)
<$ symbol "(,)"
]
instance (Source src, Inj_Sym ss (,)) => ModuleFor src ss (,) where
- moduleFor _s = ["Tuple2"] `moduleWhere`
+ moduleFor = ["Tuple2"] `moduleWhere`
[ "fst" := teTuple2_fst
, "snd" := teTuple2_snd
]
tyTuple2 :: Source src => Inj_Len vs => Type src vs a -> Type src vs b -> Type src vs (a, b)
tyTuple2 a b = tyConst @(K (,)) @(,) `tyApp` a `tyApp` b
-teTuple2 :: TermDef (,) '[Proxy a, Proxy b] (a -> b -> (a, b))
+teTuple2 :: TermDef (,) '[Proxy a, Proxy b] (() #> (a -> b -> (a, b)))
teTuple2 = Term noConstraint (a0 ~> b1 ~> tyTuple2 a0 b1) $ teSym @(,) $ lam2 tuple2
-teTuple2_fst :: TermDef (,) '[Proxy a, Proxy b] ((a, b) -> a)
+teTuple2_fst :: TermDef (,) '[Proxy a, Proxy b] (() #> ((a, b) -> a))
teTuple2_fst = Term noConstraint (tyTuple2 a0 b1 ~> a0) $ teSym @(,) $ lam1 fst
-teTuple2_snd :: TermDef (,) '[Proxy a, Proxy b] ((a, b) -> b)
+teTuple2_snd :: TermDef (,) '[Proxy a, Proxy b] (() #> ((a, b) -> b))
teTuple2_snd = Term noConstraint (tyTuple2 a0 b1 ~> b1) $ teSym @(,) $ lam1 snd