Refactor C interface to pass operation as enum

This is hmatrix style, less proliferation of functions as the number of
ops increases

1 files changed, 26 insertions, 32 deletions

diff --git a/src/Data/Array/Nested/Internal/Arith/Lists.hs b/src/Data/Array/Nested/Internal/Arith/Lists.hs
index 78fe24a..91e50ad 100644
--- a/src/Data/Array/Nested/Internal/Arith/Lists.hs
+++ b/src/Data/Array/Nested/Internal/Arith/Lists.hs
@@ -1,13 +1,13 @@
-{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# 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 Commutative = Comm | NonComm
-  deriving (Show, Eq)
 
 data ArithType = ArithType
   { atType :: Name  -- ''Int32
@@ -22,36 +22,30 @@ typesList =
   ,ArithType ''Double "double"
   ]
 
-data ArithBOp = ArithBOp
-  { aboName :: String  -- "add"
-  , aboComm :: Commutative  -- Comm
-  , aboScalFun :: ArithType -> Name  -- \_ -> '(+)
-  }
+-- data ArithBOp = BO_ADD | BO_SUB | BO_MUL deriving (Show, Enum, Bounded)
+$(genArithDataType Binop "ArithBOp")
 
-binopsList :: [ArithBOp]
-binopsList =
-  [ArithBOp "add" Comm (\_ -> '(+))
-  ,ArithBOp "sub" NonComm (\_ -> '(-))
-  ,ArithBOp "mul" Comm (\_ -> '(*))
-  ]
+$(genArithNameFun Binop ''ArithBOp "aboName" (map toLower . drop 3))
+$(genArithEnumFun Binop ''ArithBOp "aboEnum")
 
-data ArithUOp = ArithUOp
-  { auoName :: String  -- "neg"
-  }
+$(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])
 
-unopsList :: [ArithUOp]
-unopsList =
-  [ArithUOp "neg"
-  ,ArithUOp "abs"
-  ,ArithUOp "signum"
-  ]
 
-data ArithRedOp = ArithRedOp
-  { aroName :: String  -- "sum"
-  }
+-- data ArithUOp = UO_NEG | UO_ABS | UO_SIGNUM | ... deriving (Show, Enum, Bounded)
+$(genArithDataType Unop "ArithUOp")
 
-redopsList :: [ArithRedOp]
-redopsList =
-  [ArithRedOp "sum1"
-  ,ArithRedOp "product1"
-  ]
+$(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")