symantic-lib/Language/Symantic/Lib/Bounded.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 -- | Symantic for 'Bounded'.
   4 module Language.Symantic.Lib.Bounded where
   5
   6 import Prelude (Bounded)
   7 import Prelude hiding (Bounded(..))
   8 import qualified Prelude as Bounded
   9
  10 import Language.Symantic
  11 import Language.Symantic.Lib.Function (a0)
  12
  13 -- * Class 'Sym_Bounded'
  14 type instance Sym Bounded = Sym_Bounded
  15 class Sym_Bounded term where
  16         minBound :: Bounded a => term a
  17         maxBound :: Bounded a => term a
  18         default minBound :: Sym_Bounded (UnT term) => Trans term => Bounded a => term a
  19         default maxBound :: Sym_Bounded (UnT term) => Trans term => Bounded a => term a
  20         minBound = trans minBound
  21         maxBound = trans maxBound
  22
  23 -- Interpreting
  24 instance Sym_Bounded Eval where
  25         minBound = Eval Bounded.minBound
  26         maxBound = Eval Bounded.maxBound
  27 instance Sym_Bounded View where
  28         minBound = view0 "minBound"
  29         maxBound = view0 "maxBound"
  30 instance (Sym_Bounded r1, Sym_Bounded r2) => Sym_Bounded (Dup r1 r2) where
  31         minBound = dup0 @Sym_Bounded minBound
  32         maxBound = dup0 @Sym_Bounded maxBound
  33
  34 -- Transforming
  35 instance (Sym_Lambda term, Sym_Bounded term) => Sym_Bounded (BetaT term)
  36
  37 -- Typing
  38 instance NameTyOf Bounded where
  39         nameTyOf _c = ["Bounded"] `Mod` "Bounded"
  40 instance FixityOf Bounded
  41 instance ClassInstancesFor Bounded
  42 instance TypeInstancesFor Bounded
  43
  44 -- Compiling
  45 instance Gram_Term_AtomsFor src ss g Bounded
  46 instance (Source src, SymInj ss Bounded) => ModuleFor src ss Bounded where
  47         moduleFor = ["Bounded"] `moduleWhere`
  48          [ "minBound" := teBounded_minBound
  49          , "maxBound" := teBounded_maxBound
  50          ]
  51
  52 -- ** 'Type's
  53 tyBounded :: Source src => Type src vs a -> Type src vs (Bounded a)
  54 tyBounded a = tyConstLen @(K Bounded) @Bounded (lenVars a) `tyApp` a
  55
  56 -- ** 'Term's
  57 teBounded_minBound, teBounded_maxBound :: TermDef Bounded '[Proxy a] (Bounded a #> a)
  58 teBounded_minBound = Term (tyBounded a0) a0 $ teSym @Bounded $ minBound
  59 teBounded_maxBound = Term (tyBounded a0) a0 $ teSym @Bounded $ maxBound