cleanup: Serialize now mostly generically implemented

EHC/changelog.md.editthis

@@ -1,6 +1,8 @@
-- [core] pretty printing of Core AST (for debugging purposes)
+- [core] pretty printing/dump of Core AST (for debugging purposes), accessible via --coreopt=dump-ast
 - [uhc-util] move of LexScope encoding via RLList to separate module in uhc-util
 - [corerun] additional API calls
+- [grin] no longer .grin files generated, any whole grin progr stuff disabled (to be removed)
+- [serialize] serialization instances now mostly generically defined
 
 ## 1.1.9.2 - 20151027
 

EHC/src/ehc/AbstractCore.chs

@@ -394,7 +394,7 @@ data ACoreBindAspectKey
 %%[[93
   | ACoreBindAspectKey_FusionRole           -- fusion role
 %%]]
-  deriving (Eq,Ord)
+  deriving (Eq,Ord,Generic)
 
 instance Show ACoreBindAspectKey where
   show ACoreBindAspectKey_Default       = "dft"
@@ -1501,7 +1501,7 @@ data CaseAltFailReason
   | CaseAltFailReason_Continue
       { cafailCaseId        :: UID              -- failed as part of case match attempt, but continues with code identified by id
       }
-  deriving (Show,Eq,Ord)
+  deriving (Show,Eq,Ord,Generic)
 
 instance PP CaseAltFailReason where
   pp (CaseAltFailReason_Continue i) = pp i
@@ -1629,6 +1629,10 @@ instance Serialize ACoreBindAspectKey where
 %%]
 
 %%[(50 codegen) hs
+instance Serialize ACoreBindAspectKey
+%%]
+
+%%[(5050 codegen) hs
 instance Serialize ACoreBindAspectKey where
   sput (ACoreBindAspectKey_Default       ) = sputWord8 0
   sput (ACoreBindAspectKey_Strict        ) = sputWord8 1
@@ -1670,6 +1674,10 @@ instance Serialize ACoreBindRef where
 %%]
 
 %%[(50 codegen) hs
+instance Serialize CaseAltFailReason
+%%]
+
+%%[(5050 codegen) hs
 instance Serialize CaseAltFailReason where
   sput (CaseAltFailReason_Continue a) = sputWord8 0 >> sput a
   sput (CaseAltFailReason_Absence   ) = sputWord8 1

EHC/src/ehc/Base/Common.chs

@@ -389,7 +389,7 @@ data CLbl
   | CLbl_Tag
       { clblTag		:: !CTag
       }
-  deriving (Show,Eq,Ord)
+  deriving (Show,Eq,Ord,Generic)
 
 clbl :: a -> (HsName -> a) -> (CTag -> a) -> CLbl -> a
 clbl f _ _  CLbl_None   = f
@@ -681,7 +681,7 @@ data VarUIDHsName
   = VarUIDHs_Name       { vunmId :: !UID, vunmNm' :: !HsName }
   | VarUIDHs_UID        { vunmId :: !UID }
   | VarUIDHs_Var        !UID
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Generic)
 
 vunmNm :: VarUIDHsName -> HsName
 vunmNm (VarUIDHs_Name _ n) = n
@@ -1211,7 +1211,14 @@ instance Serialize KnownPrim where
 instance Serialize TagDataInfo where
   sput (TagDataInfo a b) = sput a >> sput b
   sget = liftM2 TagDataInfo sget sget
+%%]
+
+%%[50
+instance Serialize VarUIDHsName
+instance Serialize CLbl
+%%]
 
+%%[5050
 instance Serialize VarUIDHsName where
   sput (VarUIDHs_Name a b) = sputWord8 0 >> sput a >> sput b
   sput (VarUIDHs_UID  a  ) = sputWord8 1 >> sput a
@@ -1231,7 +1238,9 @@ instance Serialize CLbl where
               0 -> liftM  CLbl_Nm 	sget
               1 -> liftM  CLbl_Tag  sget
               2 -> return CLbl_None
+%%]
 
+%%[50
 instance Binary Fixity where
   put = putEnum8
   get = getEnum8

EHC/src/ehc/Base/Pragma.chs

@@ -55,7 +55,7 @@ data Pragma
       { pragmaExcludeTargets   		:: [Target]
       }
 %%]]
-  deriving (Eq,Ord,Show,Typeable)
+  deriving (Eq,Ord,Show,Typeable,Generic)
 
 %%]
 
@@ -114,6 +114,10 @@ pragmaInvolvesCmdLine _                     = False
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[99
+instance Serialize Pragma
+%%]
+
+%%[9999
 instance Serialize Pragma where
   sput (Pragma_NoImplicitPrelude        ) = sputWord8 0
   sput (Pragma_CPP                      ) = sputWord8 1

EHC/src/ehc/CHR/Constraint.chs

@@ -55,7 +55,7 @@ data Constraint' p info
                     , cnstrVarMp :: VarMp           -- additional bindings for type (etc.) variables, i.e. improving substitution
 %%]]
                     }
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
 
 type Constraint = Constraint' CHRPredOcc RedHowAnnotation
 
@@ -224,6 +224,7 @@ data RedHowAnnotation
     ( Eq, Ord
 %%[[50
     , Typeable
+    , Generic
 %%]]
     )
 %%]
@@ -275,7 +276,7 @@ data ByScopeRedHow
   deriving
     ( Eq, Ord
 %%[[50
-    , Typeable
+    , Typeable, Generic
 %%]]
     )
 
@@ -426,6 +427,10 @@ instance (PP p, PP info) => PP (Constraint' p info) where
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(50 hmtyinfer || hmtyast)
+instance (Serialize p, Serialize i) => Serialize (Constraint' p i)
+%%]
+
+%%[(5050 hmtyinfer || hmtyast)
 instance (Serialize p, Serialize i) => Serialize (Constraint' p i) where
   sput (Prove     a      ) = sputWord8 0 >> sput a
   sput (Assume    a      ) = sputWord8 1 >> sput a
@@ -438,6 +443,11 @@ instance (Serialize p, Serialize i) => Serialize (Constraint' p i) where
 %%]
 
 %%[(50 hmtyinfer)
+instance Serialize ByScopeRedHow
+instance Serialize RedHowAnnotation
+%%]
+
+%%[(5050 hmtyinfer)
 instance Serialize ByScopeRedHow where
   sput (ByScopeRedHow_Prove          ) = sputWord8 0
   sput (ByScopeRedHow_Assume         ) = sputWord8 1

EHC/src/ehc/CHR/Guard.chs

@@ -52,7 +52,7 @@ data Guard
   | EqualModuloUnification  Ty Ty
 %%]]
 %%[[50
-  deriving (Typeable)
+  deriving (Typeable, Generic)
 %%]]
 %%]
 
@@ -88,6 +88,10 @@ instance PP Guard where
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(50 hmtyinfer)
+instance Serialize Guard
+%%]
+
+%%[(5050 hmtyinfer)
 instance Serialize Guard where
   sput (HasStrictCommonScope     a b c  ) = sputWord8 0  >> sput a >> sput b >> sput c
   sput (IsVisibleInScope         a b    ) = sputWord8 1  >> sput a >> sput b

EHC/src/ehc/CHR/Key.chs

@@ -43,7 +43,7 @@ data Key
 %%]]
   deriving ( Eq, Ord
 %%[[50
-           , Typeable
+           , Typeable, Generic
 %%]]
            )
 %%]
@@ -146,6 +146,10 @@ instance TTKeyable x => TreeTrieKeyable x where
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[50
+instance Serialize Key
+%%]
+
+%%[5050
 instance Serialize Key where
   sput (Key_HNm  a) = sputWord8 0 >> sput a
   sput (Key_UID  a) = sputWord8 1 >> sput a

EHC/src/ehc/CodeGen/BasicAnnot.chs

@@ -297,7 +297,7 @@ data BasicTy
   | BasicTy_Double				-- C: double
   | BasicTy_SignedHalfWord		-- as BasicTy_Word, but for FFI half the size of a word, and signed. Special case for sign extend.
 %%]]
-  deriving (Eq,Ord,Enum)
+  deriving (Eq,Ord,Enum,Generic)
 %%]
 
 %%[(50 codegen) hs
@@ -358,7 +358,7 @@ data BasicAnnot
   	  , baIsSigned	:: Bool
   	  }
 %%]]
-  deriving (Show,Eq)
+  deriving (Show,Eq,Generic)
 %%]
 
 %%[(8 grin) hs export(basicAnnotWord)
@@ -427,6 +427,10 @@ instance Serialize BasicSize where
 %%]
 
 %%[(50 codegen) hs
+instance Serialize BasicAnnot
+%%]
+
+%%[(5050 codegen) hs
 instance Serialize BasicAnnot where
   sput (BasicAnnot_None                 ) = sputWord8 0
 %%[[(8 grin)

EHC/src/ehc/ConfigInternalVersions.chs

@@ -43,7 +43,7 @@ internalVersionCodeGen = mkInternalVersion 1
 internalVersionHI = mkInternalVersion 1
 
 -- | For binary/serialized Core .cr/.bcr/.tcr etc files
-internalVersionCore = mkInternalVersion 1
+internalVersionCore = mkInternalVersion 2
 
 -- | For binary/serialized CoreRun .crr/.bcrr./tcrr etc files
 internalVersionCoreRun = mkInternalVersion 1

EHC/src/ehc/Core.cag

@@ -76,6 +76,11 @@ DERIVING *
   : Show
 %%]
 
+%%[(50 core) ag
+DERIVING *
+  : Generic
+%%]
+
 %%[(100 core) -8.derivingShow hs
 -- | Explicit dummy instances instead of derived ones which not really are used except as context for PP
 instance Show CExpr where
@@ -778,6 +783,24 @@ instance AbstractCore CExpr CMetaVal CBind CBound ACoreAppLikeMetaBound CBindCat
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(50 core) hs
+instance Serialize CModule
+instance Serialize CExport 
+instance Serialize CImport
+instance Serialize CDeclMeta
+instance Serialize CDataCon
+instance Serialize CExpr
+instance Serialize CMetaVal
+instance Serialize CExprAnn
+instance Serialize CBindAnn
+instance Serialize CBound
+instance Serialize CBind
+instance Serialize CAlt
+instance Serialize CPat
+instance Serialize CPatRest
+instance Serialize CPatFld
+%%]
+
+%%[(5050 core) hs
 instance Serialize CModule where
   sput (CModule_Mod   a b c d e) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d >> sput e
   sget
@@ -989,7 +1012,9 @@ instance Serialize CPatFld where
     = do {- t <- sgetWord8
          case t of
             0 -> -} liftM4 CPatFld_Fld         sget sget sget sget
+%%]
 
+%%[(50 core) hs
 instance Serialize CBindCateg where
   sput = sputEnum8
   sget = sgetEnum8

EHC/src/ehc/CoreRun.cag

@@ -59,6 +59,7 @@ CoreRun is a simplified Core intended for running it using an efficient as possi
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(8 corerun) ag import({CoreRun/AbsSyn})
+DERIVING * : Generic
 %%]
 
 %%[(8 corerun) hs
@@ -206,7 +207,7 @@ data RRef
   | RRef_Dbg
       { rrefNm          :: !HsName
       }
-  deriving (Eq,Ord)
+  deriving (Eq,Ord,Generic)
 
 instance Show RRef where
   show _ = "RRef"
@@ -325,14 +326,37 @@ ref2nmUnion = Rel.union -- m1 m2 = \r -> m1 r <|> m2 r
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %%[(50 corerun) hs
-instance Binary Mod where
-  put (Mod_Mod a b c d e f g h i) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h >> put i
-  get = liftM9 Mod_Mod get get get get get get get get get
-
 instance Serialize Mod where
   sput = sputPlain
   sget = sgetPlain
 
+instance Binary RunPrim where
+  put = putEnum
+  get = getEnum
+
+instance Binary a => Binary (CRArray a) where
+  put = put . crarrayToList 
+  get = fmap crarrayFromList get
+%%]
+
+%%[(50 corerun) hs
+instance Binary Mod
+instance Binary Meta
+instance Binary Import
+instance Binary Export
+instance Binary DataCon
+instance Binary Exp
+instance Binary SExp
+instance Binary Alt
+instance Binary Pat
+instance Binary RRef
+%%]
+
+%%[(5050 corerun) hs
+instance Binary Mod where
+  put (Mod_Mod a b c d e f g h i) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h >> put i
+  get = liftM9 Mod_Mod get get get get get get get get get
+
 instance Binary Meta where
   put (Meta_Data a b) = {- putWord8 0 >> -} put a >> put b
   get = {- do t <- getWord8
@@ -411,10 +435,6 @@ instance Binary Pat where
            case t of
              0 -> -} liftM  Pat_Con 		get
 
-instance Binary RunPrim where
-  put = putEnum
-  get = getEnum
-
 instance Binary RRef where
   put (RRef_Glb 		a b			) = putWord8 0 >> put a >> put b
   put (RRef_Loc 		a b			) = putWord8 1 >> put a >> put b
@@ -439,9 +459,6 @@ instance Binary RRef where
              8 -> liftM2 RRef_Exp 		get get
              9 -> liftM  RRef_Unr 		get
 
-instance Binary a => Binary (CRArray a) where
-  put = put . crarrayToList 
-  get = fmap crarrayFromList get
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

EHC/src/ehc/EHC/CompilePhase/Output.chs

@@ -188,7 +188,7 @@ cpOutputTyCore suff modNm
 %%[(8 codegen) export(cpOutputCore)
 cpOutputCore :: EHCCompileRunner m => ASTFileContent -> String -> String -> HsName -> EHCompilePhaseT m FPath
 cpOutputCore how nmsuff suff modNm =
-    fmap (panicJust "cpOutputGrin.cpOutputSomeModule") $
+    fmap (panicJust "cpOutputCore.cpOutputSomeModule") $
       cpOutputSomeModule (^. ecuCore) astHandler'_Core how nmsuff suff modNm
 %%]
 

EHC/src/ehc/EHC/CompilePhase/Parsers.chs

@@ -310,7 +310,7 @@ cpGetPrevCoreRun modNm
        }
 %%]
 
-%%[(50 codegen grin) export(cpGetPrevGrin)
+%%[(5050 codegen grin) export(cpGetPrevGrin)
 cpGetPrevGrin :: EHCCompileRunner m => HsName -> EHCompilePhaseT m AST_Grin
 cpGetPrevGrin modNm
   = do { cpMsg modNm VerboseDebug "cpGetPrevGrin"