Language/Symantic/Expr/Int.hs

   1 {-# LANGUAGE DefaultSignatures #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE TypeOperators #-}
   6 -- | Expression for 'Int'.
   7 module Language.Symantic.Expr.Int where
   8
   9 import Prelude hiding ((+), (-), (*), abs, mod, negate)
  10
  11 import Language.Symantic.Type
  12 import Language.Symantic.Expr.Common
  13 import Language.Symantic.Repr.Dup
  14 import Language.Symantic.Trans.Common
  15
  16 -- * Class 'Sym_Int'
  17 -- | Symantic.
  18 class Sym_Int repr where
  19         int    ::      Int -> repr Int
  20         abs    :: repr Int -> repr Int
  21         negate :: repr Int -> repr Int
  22         (+)    :: repr Int -> repr Int -> repr Int
  23         (-)    :: repr Int -> repr Int -> repr Int
  24         (*)    :: repr Int -> repr Int -> repr Int
  25         mod    :: repr Int -> repr Int -> repr Int
  26
  27         default int    :: Trans t repr =>        Int -> t repr Int
  28         default abs    :: Trans t repr => t repr Int -> t repr Int
  29         default negate :: Trans t repr => t repr Int -> t repr Int
  30         default (+)    :: Trans t repr => t repr Int -> t repr Int -> t repr Int
  31         default (-)    :: Trans t repr => t repr Int -> t repr Int -> t repr Int
  32         default (*)    :: Trans t repr => t repr Int -> t repr Int -> t repr Int
  33         default mod    :: Trans t repr => t repr Int -> t repr Int -> t repr Int
  34         int    = trans_lift . int
  35         abs    = trans_map1 abs
  36         negate = trans_map1 negate
  37         (+)    = trans_map2 (+)
  38         (-)    = trans_map2 (-)
  39         (*)    = trans_map2 (*)
  40         mod    = trans_map2 mod
  41 infixl 6 +
  42 infixl 6 -
  43 infixl 7 *
  44 infixl 7 `mod`
  45
  46 instance -- Sym_Int Dup
  47  ( Sym_Int r1
  48  , Sym_Int r2
  49  ) => Sym_Int (Dup r1 r2) where
  50         int     x                          = int x     `Dup` int x
  51         abs    (x1 `Dup` x2)               = abs x1    `Dup` abs x2
  52         negate (x1 `Dup` x2)               = negate x1 `Dup` negate x2
  53         (+)    (x1 `Dup` x2) (y1 `Dup` y2) = (+) x1 y1 `Dup` (+) x2 y2
  54         (-)    (x1 `Dup` x2) (y1 `Dup` y2) = (-) x1 y1 `Dup` (-) x2 y2
  55         (*)    (x1 `Dup` x2) (y1 `Dup` y2) = (*) x1 y1 `Dup` (*) x2 y2
  56         mod    (x1 `Dup` x2) (y1 `Dup` y2) = mod x1 y1 `Dup` mod x2 y2
  57
  58 -- * Type 'Expr_Int'
  59 -- | Expression.
  60 data Expr_Int (root:: *)
  61 type instance Root_of_Expr      (Expr_Int root)      = root
  62 type instance Type_of_Expr      (Expr_Int root)      = Type_Int
  63 type instance Sym_of_Expr       (Expr_Int root) repr = Sym_Int repr
  64 type instance Error_of_Expr ast (Expr_Int root)      = No_Error_Expr