Use flat for .ty serialization

compiler/Acton/Syntax.hs

@@ -14,6 +14,7 @@
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveGeneric, DeriveAnyClass #-}
 module Acton.Syntax where
 
+import Flat
 import Utils
 import qualified Data.Binary
 import qualified Data.Set
@@ -116,9 +117,9 @@ data Pattern    = PWild         { ploc::SrcLoc, pann::Maybe Type }
 type Target     = Expr
 
 data Prefix     = Globvar | Kindvar | Xistvar | Typevar | Tempvar | Witness | NormPass | CPSPass | LLiftPass
-                deriving (Eq,Ord,Show,Read,Generic,NFData)
+                deriving (Eq,Ord,Show,Read,Generic,NFData,Flat)
 
-data Name       = Name SrcLoc String | Derived Name Name | Internal Prefix String Int deriving (Generic,Show,NFData)
+data Name       = Name SrcLoc String | Derived Name Name | Internal Prefix String Int deriving (Generic,Show,NFData,Flat)
 
 nloc (Name l _) = l
 nloc _          = NoLoc
@@ -154,7 +155,7 @@ globalName s    = Internal Globvar s 0
 globalNames s   = map (Internal Globvar s) [1..]
 
 
-data ModName    = ModName [Name] deriving (Show,Read,Eq,Generic,NFData)
+data ModName    = ModName [Name] deriving (Show,Read,Eq,Generic,NFData,Flat)
 
 modName ss      = ModName (map name ss)
 
@@ -165,7 +166,7 @@ modCat (ModName ns) n = ModName (ns++[n])
 instance Ord ModName where
     compare a b = compare (modPath a) (modPath b)
 
-data QName      = QName { mname::ModName, noq::Name } | NoQ { noq::Name } | GName { mname::ModName, noq::Name } deriving (Show,Read,Eq,Ord,Generic,NFData)
+data QName      = QName { mname::ModName, noq::Name } | NoQ { noq::Name } | GName { mname::ModName, noq::Name } deriving (Show,Read,Eq,Ord,Generic,NFData,Flat)
 
 qName ss s      = QName (modName ss) (name s)
 
@@ -206,19 +207,19 @@ data Binary     = Or|And|Plus|Minus|Mult|Pow|Div|Mod|EuDiv|BOr|BXor|BAnd|ShiftL|
 data Aug        = PlusA|MinusA|MultA|PowA|DivA|ModA|EuDivA|BOrA|BXorA|BAndA|ShiftLA|ShiftRA|MMultA deriving (Show,Eq)
 data Comparison = Eq|NEq|LtGt|Lt|Gt|GE|LE|In|NotIn|Is|IsNot deriving (Show,Eq)
 
-data Deco       = NoDec | Property | Static deriving (Eq,Show,Read,Generic,NFData)
+data Deco       = NoDec | Property | Static deriving (Eq,Show,Read,Generic,NFData,Flat)
 
-data Kind       = KType | KProto | KFX | PRow | KRow | KFun [Kind] Kind | KVar Name | KWild deriving (Eq,Ord,Show,Read,Generic,NFData)
+data Kind       = KType | KProto | KFX | PRow | KRow | KFun [Kind] Kind | KVar Name | KWild deriving (Eq,Ord,Show,Read,Generic,NFData,Flat)
 
-data TSchema    = TSchema { scloc::SrcLoc, scbind::QBinds, sctype::Type } deriving (Show,Read,Generic,NFData)
+data TSchema    = TSchema { scloc::SrcLoc, scbind::QBinds, sctype::Type } deriving (Show,Read,Generic,NFData,Flat)
 
-data TVar       = TV { tvkind::Kind, tvname::Name } deriving (Show,Read,Generic,NFData) -- the Name is an uppercase letter, optionally followed by digits.
+data TVar       = TV { tvkind::Kind, tvname::Name } deriving (Show,Read,Generic,NFData,Flat) -- the Name is an uppercase letter, optionally followed by digits.
 
-data TCon       = TC { tcname::QName, tcargs::[Type] } deriving (Eq,Show,Read,Generic,NFData)
+data TCon       = TC { tcname::QName, tcargs::[Type] } deriving (Eq,Show,Read,Generic,NFData,Flat)
 
-data FX         = FXPure | FXMut | FXProc | FXAction deriving (Eq,Show,Read,Generic,NFData)
+data FX         = FXPure | FXMut | FXProc | FXAction deriving (Eq,Show,Read,Generic,NFData,Flat)
 
-data QBind      = Quant TVar [TCon] deriving (Eq,Show,Read,Generic,NFData)
+data QBind      = Quant TVar [TCon] deriving (Eq,Show,Read,Generic,NFData,Flat)
 
 type QBinds     = [QBind]
 
@@ -237,7 +238,7 @@ data Type       = TVar      { tloc::SrcLoc, tvar::TVar }
                 | TNil      { tloc::SrcLoc, rkind::Kind }
                 | TRow      { tloc::SrcLoc, rkind::Kind, label::Name, rtype::Type, rtail::TRow }
                 | TFX       { tloc::SrcLoc, tfx::FX }
-                deriving (Show,Read,Generic,NFData)
+                deriving (Show,Read,Generic,NFData,Flat)
 
 type TFX        = Type
 type PosRow     = Type
@@ -431,7 +432,7 @@ data NameInfo           = NVar      Type
                         | NMAlias   ModName
                         | NModule   TEnv
                         | NReserved
-                        deriving (Eq,Show,Read,Generic)
+                        deriving (Eq,Show,Read,Generic,Flat)
 
 data Witness            = WClass    { binds::QBinds, wtype::Type, proto::PCon, wname::QName, wsteps::WPath }
                         | WInst     { binds::QBinds, wtype::Type, proto::PCon, wname::QName, wsteps::WPath }

compiler/InterfaceFiles.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -- Copyright (C) 2019-2021 Data Ductus AB
 --
 -- Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
@@ -13,24 +14,33 @@
 
 module InterfaceFiles where
 
-import Data.Binary
-import qualified Data.ByteString.Lazy
+import Flat
+import Flat.Decoder
+import qualified Data.ByteString.Lazy as BL
 import Codec.Compression.Zlib
 import qualified System.Exit
 import qualified Acton.Syntax
 import System.IO
 
 writeFile :: FilePath -> [Acton.Syntax.ModName] -> Acton.Syntax.TEnv -> IO ()
-writeFile f ms a = do h <- openFile f WriteMode
-                      Data.ByteString.Lazy.hPut h (compress (encode (Acton.Syntax.version, (ms,a))))
-                      hClose h
+writeFile f ms a = do
+  h <- openFile f WriteMode
+  BL.hPut h (compress $ BL.fromStrict $ flat (Acton.Syntax.version, (ms, a)))
+  hClose h
 
 readFile :: FilePath -> IO ([Acton.Syntax.ModName], Acton.Syntax.TEnv)
 readFile f = do
-      h <- openFile f ReadMode
-      bs <- Data.ByteString.Lazy.hGetContents h
-      let (vs,a) = decode (decompress bs)
-      if vs == Acton.Syntax.version then do hClose h
-                                            return a
-        else do putStrLn ("Interface file has version "++show vs++"; current version is "++show Acton.Syntax.version)
-                System.Exit.exitFailure
+  h <- openFile f ReadMode
+  bs <- BL.hGetContents h
+  let decoded = unflat $ BL.toStrict $ decompress bs
+  case decoded of
+    Left (e :: DecodeException) -> do
+      putStrLn "Error during deserialization"
+      System.Exit.exitFailure
+    Right (vs, a) ->
+      if vs == Acton.Syntax.version then do
+        hClose h
+        return a
+      else do
+        putStrLn $ "Interface file has version " ++ show vs ++ "; current version is " ++ show Acton.Syntax.version
+        System.Exit.exitFailure

compiler/Utils.hs

@@ -14,6 +14,7 @@
 {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-}
 module Utils(module Utils, module SrcLocation, module Data.List, module Data.Maybe, module Debug.Trace) where
 
+import Flat
 import Debug.Trace
 import Data.List hiding ((\\))
 import Data.Maybe
@@ -26,7 +27,7 @@ import Pretty
 import Control.DeepSeq
 import Prelude hiding((<>))
 
-data SrcLoc                     = Loc Int Int | NoLoc deriving (Eq,Ord,Show,Read,Generic,NFData)
+data SrcLoc                     = Loc Int Int | NoLoc deriving (Eq,Ord,Show,Read,Generic,NFData,Flat)
 
 instance Data.Binary.Binary SrcLoc
 

compiler/package.yaml.in

@@ -13,7 +13,7 @@ copyright:           "2018 Author name here"
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on Github at <https://github.com/githubuser/simple#readme>
+description:         Please see the README on Github at <https://github.com/actonlang/acton#readme>
 
 executables:
   actonc:
@@ -35,6 +35,7 @@ executables:
       - directory >= 1.3.1
       - filelock
       - filepath
+      - flat
       - hashable
       - megaparsec >= 9
       - mtl