Clean up EMGM adapter

norm2782 · Feb 4, 2011 · 98a4da1 · 98a4da1
1 parent ddcc72b
commit 98a4da1
Showing 1 changed file with 10 additions and 20 deletions.
diff --git a/src/DGG/Adapter/EMGM.hs b/src/DGG/Adapter/EMGM.hs
@@ -57,7 +57,11 @@ mkEPName n = "dggEP_" ++ (fromName n)
 
 createDTEP :: TCInfo -> Decl
 createDTEP (TCInfo tn TyDataType _ vcis) =
-  PatBind srcLoc (mkPIdent $ mkEPName tn) Nothing rhs (mkBDecls vcis)
+  PatBind srcLoc (mkPIdent $ mkEPName tn) Nothing
+  (UnGuardedRhs (App (App (Con $ mkUId "EP") (mkIdent fromFunName))
+  (mkIdent toFunName))) (BDecls [ FunBind $ map (bdeclFrom ln) vcis
+                                , FunBind $ map (bdeclTo ln) vcis ])
+  where ln = length vcis
 
 createNTEP   (TCInfo tn TyNewType _ vcis) = undefined
 createSynEP  (TCInfo tn TySynonym _ vcis) = undefined
@@ -68,16 +72,6 @@ fromFunName = "from'"
 toFunName   = "to'"
 unitType    = "Unit"
 
-rhs :: Rhs
-rhs = UnGuardedRhs (App (App (Con $ mkUId "EP")
-                             (mkIdent fromFunName))
-                             (mkIdent toFunName))
-
-mkBDecls :: [DCInfo] -> Binds
-mkBDecls vcis = BDecls [ FunBind $ map (bdeclFrom ln) vcis
-                     , FunBind $ map (bdeclTo ln) vcis ]
-    where ln = length vcis
-
 --    --
 --    --
 -- EP --
@@ -94,16 +88,17 @@ bdeclFrom cnt dci = mkMatch fromFunName [pApp n (map mkPIdent (genNames a))]
 fromEP :: Int -> Int -> DCInfo -> Exp
 fromEP = ep mkFromRs mkExpSum owFrom
 
-owFrom :: Int -> Int -> DCInfo -> Exp
-owFrom cnt nc dci = App (mkStrCon "R") (fromEP (cnt + 1) nc dci)
-
 mkFromRs :: Int -> Exp
 mkFromRs 0  = mkStrCon unitType
-mkFromRs rs = buildProd rs
+mkFromRs n = foldInApp' (QConOp . unQualSym $ ":*:") mkIdent $ genNames n
 
 mkExpSum :: String -> Int -> Exp
 mkExpSum s n = (App . mkStrCon) s $ mkFromRs n
 
+owFrom :: Int -> Int -> DCInfo -> Exp
+owFrom cnt nc dci = App (mkStrCon "R") (fromEP (cnt + 1) nc dci)
+
+
 -- To
 bdeclTo :: Int -> DCInfo -> Match
 bdeclTo cnt dci = mkMatch toFunName [toEP 0 cnt dci] (mkToRhs dci)
@@ -127,11 +122,6 @@ mkToRhs dci | a == 0    = mkNCon n
 mkPatSum :: String -> Int -> Pat
 mkPatSum s n = pApp (name s) [mkToRs n]
 
--- Generic
-
-buildProd :: Int -> Exp
-buildProd n = foldInApp' ((QConOp . unQualSym) ":*:") mkIdent $ genNames n
-
 -- TODO: Port this back to foldInApp
 foldInApp' :: QOp -> (a -> Exp) -> [a] -> Exp
 foldInApp' _  mk [x]    = mk x