Remove dependency on ghc-prim.

[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / Tuple2.hs

diff --git a/symantic-lib/Language/Symantic/Lib/Tuple2.hs b/symantic-lib/Language/Symantic/Lib/Tuple2.hs
index 3fbe25fb43127ceb6cf861320dd5d8aec0de7b13..43c20b536d2aee36d7c136883f65eee81211ce9c 100644 (file)
--- a/symantic-lib/Language/Symantic/Lib/Tuple2.hs
+++ b/symantic-lib/Language/Symantic/Lib/Tuple2.hs
@@ -15,7 +15,7 @@ import Language.Symantic.Lib.MonoFunctor (Element)
 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
@@ -50,8 +50,10 @@ instance (Sym_Tuple2 r1, Sym_Tuple2 r2) => Sym_Tuple2 (Dup r1 r2) where
 instance (Sym_Tuple2 term, Sym_Lambda term) => Sym_Tuple2 (BetaT term)
 
 -- Typing
+instance NameTyOf (,) where
+       nameTyOf _c = ["Tuple2"] `Mod` ","
 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
@@ -95,40 +97,40 @@ instance TypeInstancesFor (,) where
 
 -- Compiling
 instance
- ( Gram_Alt g
+ ( Gram_Source src g
+ , Gram_Alt g
  , Gram_Rule g
  , Gram_Comment g
- , Gram_Meta src g
  , Gram_Term src ss g
- , Inj_Sym ss (,)
+ , SymInj ss (,)
  ) => Gram_Term_AtomsFor src ss g (,) where
-       g_term_atomsFor _t =
+       g_term_atomsFor =
         -- TODO: proper TupleSections
         [ rule "teTuple2_2" $
-               withMeta $ parens $
+               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" $
-               withMeta $
-               (\src -> BinTree0 $ Token_Term $ TermVT_CF $ (`setSource` src) $ teTuple2)
+               source $
+               (\src -> BinTree0 $ Token_Term $ TermAVT $ (`setSource` src) $ teTuple2)
                 <$ symbol "(,)"
         ]
-instance (Source src, Inj_Sym ss (,)) => Module src ss (,) where
-       module_ _s = [] `moduleWhere`
+instance (Source src, SymInj ss (,)) => ModuleFor src ss (,) where
+       moduleFor = ["Tuple2"] `moduleWhere`
         [ "fst" := teTuple2_fst
         , "snd" := teTuple2_snd
         ]
 
 -- ** 'Term's
-tyTuple2 :: Source src => Inj_Len vs => Type src vs a -> Type src vs b -> Type src vs (a, b)
+tyTuple2 :: Source src => LenInj 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