tests/Symantic/Syntaxes/Extras.hs

   1 {-# LANGUAGE UndecidableInstances #-}
   2
   3 module Symantic.Syntaxes.Extras where
   4
   5 import Data.Function qualified as Fun
   6 import Data.Int (Int)
   7 import Debug.Trace (trace)
   8 import Symantic.Semantics.Identity
   9 import Symantic.Semantics.LetInserter
  10 import Symantic.Semantics.Viewer
  11 import Symantic.Semantics.Viewer.Fixity
  12 import Symantic.Syntaxes.Classes (Abstractable (..), Instantiable (..))
  13 import Symantic.Syntaxes.Derive
  14 import Text.Show (show, showString)
  15 import Prelude qualified
  16
  17 -- * Type 'Addable'
  18 class Addable sem where
  19   add :: sem (Int -> Int -> Int)
  20   default add ::
  21     FromDerived Addable sem =>
  22     sem (Int -> Int -> Int)
  23   add = liftDerived add
  24 infixl 6 `add`, +
  25 (+) ::
  26   Instantiable sem =>
  27   Addable sem =>
  28   sem Int ->
  29   sem Int ->
  30   sem Int
  31 (+) x y = add .@ x .@ y
  32 instance Addable sem => Addable (OpenCode sem)
  33 instance Addable sem => Addable (AnnotatedCode sem)
  34 instance Addable sem => Addable (LetInserter sem)
  35 instance Addable Viewer where
  36   add = ViewerInfix (infixB SideL 6) "(+)" "+"
  37 instance Addable Identity where
  38   add = lam (\x -> lam (x Prelude.+))
  39
  40 -- * Type 'Traceable'
  41 class Logable sem where
  42   log :: Prelude.String -> sem a -> sem a
  43   default log ::
  44     FromDerived1 Logable sem =>
  45     Prelude.String ->
  46     sem a ->
  47     sem a
  48   log msg = liftDerived1 (log msg)
  49 instance Logable sem => Logable (OpenCode sem)
  50 instance Logable sem => Logable (AnnotatedCode sem)
  51 instance Logable sem => Logable (LetInserter sem)
  52 instance Logable Viewer where
  53   log msg a = Viewer (\_env -> showString "log " Fun.. showString (show msg)) .@ a
  54 instance Logable Identity where
  55   log msg = Identity Fun.. trace msg Fun.. runIdentity
  56
  57 -- * Type 'Substractable'
  58 class Substractable sem where
  59   substract :: sem (Int -> Int -> Int)
  60   default substract ::
  61     FromDerived Substractable sem =>
  62     sem (Int -> Int -> Int)
  63   substract = liftDerived substract
  64 infixl 6 `substract`, -
  65 (-) ::
  66   Instantiable sem =>
  67   Substractable sem =>
  68   sem Int ->
  69   sem Int ->
  70   sem Int
  71 (-) x y = substract .@ x .@ y
  72 instance Substractable sem => Substractable (OpenCode sem)
  73 instance Substractable sem => Substractable (AnnotatedCode sem)
  74 instance Substractable sem => Substractable (LetInserter sem)
  75 instance Substractable Viewer where
  76   substract = ViewerInfix (infixB SideL 6) "(-)" "-"
  77 instance Substractable Identity where
  78   substract = lam (\x -> lam (x Prelude.-))
  79
  80 -- * Type Multiplicable
  81 class Multiplicable sem where
  82   multiply :: sem (Int -> Int -> Int)
  83   default multiply ::
  84     FromDerived Multiplicable sem =>
  85     sem (Int -> Int -> Int)
  86   multiply = liftDerived multiply
  87 infixl 7 `multiply`, *
  88 (*) ::
  89   Instantiable sem =>
  90   Multiplicable sem =>
  91   sem Int ->
  92   sem Int ->
  93   sem Int
  94 (*) x y = multiply .@ x .@ y
  95 instance Multiplicable sem => Multiplicable (OpenCode sem)
  96 instance Multiplicable sem => Multiplicable (AnnotatedCode sem)
  97 instance Multiplicable sem => Multiplicable (LetInserter sem)
  98 instance Multiplicable Viewer where
  99   multiply = ViewerInfix (infixB SideL 7) "(*)" "*"
 100 instance Multiplicable Identity where
 101   multiply = lam (\x -> lam (x Prelude.*))
 102
 103 -- * Type Divisible
 104 class Divisible i sem where
 105   divide :: sem (i -> i -> i)
 106   default divide ::
 107     FromDerived (Divisible i) sem =>
 108     sem (i -> i -> i)
 109   divide = liftDerived divide
 110 infixl 7 `divide`, /
 111 (/) ::
 112   Instantiable sem =>
 113   Divisible i sem =>
 114   sem i ->
 115   sem i ->
 116   sem i
 117 (/) x y = divide .@ x .@ y
 118 instance Divisible i sem => Divisible i (OpenCode sem)
 119 instance Divisible i sem => Divisible i (AnnotatedCode sem)
 120 instance Divisible i sem => Divisible i (LetInserter sem)
 121 instance Divisible i Viewer where
 122   divide = ViewerInfix (infixB SideL 7) "(/)" "/"
 123 instance Prelude.Fractional i => Divisible i Identity where
 124   divide = lam (\x -> lam (x Prelude./))