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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# 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"
}
floatTypesList :: [ArithType]
floatTypesList =
[ArithType ''Float "float"
,ArithType ''Double "double"
]
typesList :: [ArithType]
typesList =
[ArithType ''Int32 "i32"
,ArithType ''Int64 "i64"
]
++ floatTypesList
-- 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 ArithFBOp = FB_DIV deriving (Show, Enum, Bounded)
$(genArithDataType FBinop "ArithFBOp")
$(genArithNameFun FBinop ''ArithFBOp "afboName" (map toLower . drop 3))
$(genArithEnumFun FBinop ''ArithFBOp "afboEnum")
$(do clauses <- readArithLists FBinop
(\name _num hsop -> return (Clause [ConP (mkName name) [] []]
(NormalB (VarE 'mkName `AppE` LitE (StringL hsop)))
[]))
return
sequence [SigD (mkName "afboNumOp") <$> [t| ArithFBOp -> Name |]
,return $ FunD (mkName "afboNumOp") 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 ArithFUOp = FU_RECIP | ... deriving (Show, Enum, Bounded)
$(genArithDataType FUnop "ArithFUOp")
$(genArithNameFun FUnop ''ArithFUOp "afuoName" (map toLower . drop 3))
$(genArithEnumFun FUnop ''ArithFUOp "afuoEnum")
-- 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")
|
