src/Data/Array/Nested/Internal/Arith/Lists.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Array.Nested.Internal.Arith.Lists where

import Data.Char
import Data.Int
import Language.Haskell.TH

import Data.Array.Nested.Internal.Arith.Lists.TH


data ArithType = ArithType
  { atType :: Name  -- ''Int32
  , atCName :: String  -- "i32"
  }

typesList :: [ArithType]
typesList =
  [ArithType ''Int32 "i32"
  ,ArithType ''Int64 "i64"
  ,ArithType ''Float "float"
  ,ArithType ''Double "double"
  ]

-- data ArithBOp = BO_ADD | BO_SUB | BO_MUL deriving (Show, Enum, Bounded)
$(genArithDataType Binop "ArithBOp")

$(genArithNameFun Binop ''ArithBOp "aboName" (map toLower . drop 3))
$(genArithEnumFun Binop ''ArithBOp "aboEnum")

$(do clauses <- readArithLists Binop
                  (\name _num hsop -> return (Clause [ConP (mkName name) [] []]
                                                     (NormalB (VarE 'mkName `AppE` LitE (StringL hsop)))
                                                     []))
                  return
     sequence [SigD (mkName "aboNumOp") <$> [t| ArithBOp -> Name |]
              ,return $ FunD (mkName "aboNumOp") clauses])


-- data ArithUOp = UO_NEG | UO_ABS | UO_SIGNUM | ... deriving (Show, Enum, Bounded)
$(genArithDataType Unop "ArithUOp")

$(genArithNameFun Unop ''ArithUOp "auoName" (map toLower . drop 3))
$(genArithEnumFun Unop ''ArithUOp "auoEnum")


-- data ArithRedOp = RO_SUM1 | RO_PRODUCT1 deriving (Show, Enum, Bounded)
$(genArithDataType Redop "ArithRedOp")

$(genArithNameFun Redop ''ArithRedOp "aroName" (map toLower . drop 3))
$(genArithEnumFun Redop ''ArithRedOp "aroEnum")