lcc/Hcompta/LCC/Sym/Addable.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Addable'.
   4 module Hcompta.LCC.Sym.Addable where
   5
   6 import Language.Symantic
   7 import Language.Symantic.Lib (a0)
   8
   9 import Hcompta.Quantity as H hiding ((+))
  10 import qualified Hcompta.Quantity as H
  11
  12 -- * Class 'Sym_Addable'
  13 type instance Sym Addable = Sym_Addable
  14 class Sym_Addable term where
  15         (+) :: Addable a => term a -> term a -> term a; infixl 6 +
  16         default (+) :: Sym_Addable (UnT term) => Trans term => Addable a => term a -> term a -> term a
  17         (+) = trans2 (+)
  18
  19 instance Sym_Addable Eval where
  20         (+) = eval2 (H.+)
  21 instance Sym_Addable View where
  22         (+) = viewInfix "+" (infixB SideL 6)
  23 instance (Sym_Addable r1, Sym_Addable r2) => Sym_Addable (Dup r1 r2) where
  24         (+) = dup2 @Sym_Addable (+)
  25 instance (Sym_Addable term, Sym_Lambda term) => Sym_Addable (BetaT term)
  26
  27 instance NameTyOf Addable where
  28         nameTyOf _c = ["Addable"] `Mod` "Addable"
  29 instance FixityOf Addable
  30 instance ClassInstancesFor Addable
  31 instance TypeInstancesFor Addable
  32 instance Gram_Term_AtomsFor src ss g Addable
  33 instance (Source src, SymInj ss Addable) => ModuleFor src ss Addable where
  34         moduleFor = ["Addable"] `moduleWhere`
  35          [ "+" `withInfixB` (SideL, 6) := teAddable_add
  36          ]
  37
  38 tyAddable :: Source src => Type src vs a -> Type src vs (Addable a)
  39 tyAddable a = tyConstLen @(K Addable) @Addable (lenVars a) `tyApp` a
  40
  41 teAddable_add :: TermDef Addable '[Proxy a] (Addable a #> (a -> a -> a))
  42 teAddable_add = Term (tyAddable a0) (a0 ~> a0 ~> a0) (teSym @Addable (lam2 (+)))