stack: bump to lts-12.25
[comptalang.git] / lcc / Hcompta / LCC / Sym / Addable.hs
index bceb6e459b55a96b4b99840a7f73ead3c7a9d323..069707aacc5597c7a4041e30f6bd2a8b03440d1c 100644 (file)
@@ -6,29 +6,32 @@ module Hcompta.LCC.Sym.Addable where
 import Language.Symantic
 import Language.Symantic.Lib (a0)
 
-import Hcompta.Quantity
+import Hcompta.Quantity as H hiding ((+))
+import qualified Hcompta.Quantity as H
 
 -- * Class 'Sym_Addable'
-type instance Sym (Proxy Addable) = Sym_Addable
+type instance Sym Addable = Sym_Addable
 class Sym_Addable term where
        (+) :: Addable a => term a -> term a -> term a; infixl 6 +
        default (+) :: Sym_Addable (UnT term) => Trans term => Addable a => term a -> term a -> term a
        (+) = trans2 (+)
 
 instance Sym_Addable Eval where
-       (+) = eval2 quantity_add
+       (+) = eval2 (H.+)
 instance Sym_Addable View where
        (+) = viewInfix "+" (infixB SideL 6)
 instance (Sym_Addable r1, Sym_Addable r2) => Sym_Addable (Dup r1 r2) where
        (+) = dup2 @Sym_Addable (+)
 instance (Sym_Addable term, Sym_Lambda term) => Sym_Addable (BetaT term)
 
+instance NameTyOf Addable where
+       nameTyOf _c = ["Addable"] `Mod` "Addable"
 instance FixityOf Addable
 instance ClassInstancesFor Addable
 instance TypeInstancesFor Addable
 instance Gram_Term_AtomsFor src ss g Addable
-instance (Source src, Inj_Sym ss Addable) => ModuleFor src ss Addable where
-       moduleFor _s = ["Addable"] `moduleWhere`
+instance (Source src, SymInj ss Addable) => ModuleFor src ss Addable where
+       moduleFor = ["Addable"] `moduleWhere`
         [ "+" `withInfixB` (SideL, 6) := teAddable_add
         ]