6 files changed, 11 insertions, 54 deletions

diff --git a/src/LambdaCube/Compiler.hs b/src/LambdaCube/Compiler.hs
index 46288639..92708fba 100644
--- a/src/LambdaCube/Compiler.hs
+++ b/src/LambdaCube/Compiler.hs
@@ -14,7 +14,6 @@ module LambdaCube.Compiler
 
     , MMT, runMMT, mapMMT
     , MM, runMM
-    , catchErr
     , ioFetch, decideFilePath
     , loadModule, getDef, compileMain, parseModule, preCompile
     , removeFromCache
@@ -35,9 +34,7 @@ import Control.Monad.State.Strict
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.Except
-import Control.DeepSeq
 import Control.Monad.Catch
-import Control.Exception hiding (catch, bracket, finally, mask)
 import Control.Arrow hiding ((<+>))
 import System.FilePath
 --import Debug.Trace
@@ -117,12 +114,6 @@ runMM fetcher
     . flip runReaderT fetcher
     . runMMT
 
-catchErr :: (MonadCatch m, NFData a, MonadIO m) => (String -> m a) -> m a -> m a
-catchErr er m = (force <$> m >>= liftIO . evaluate) `catch` getErr `catch` getPMatchFail
-  where
-    getErr (e :: ErrorCall) = catchErr er $ er $ show e
-    getPMatchFail (e :: PatternMatchFail) = catchErr er $ er $ show e
-
 -- TODO: remove dependent modules from cache too?
 removeFromCache :: Monad m => FilePath -> MMT m x ()
 removeFromCache f = modify $ \m@(Modules nm im ni) -> case Map.lookup f nm of
diff --git a/src/LambdaCube/Compiler/DesugaredSource.hs b/src/LambdaCube/Compiler/DesugaredSource.hs
index 608d669f..cbf5266e 100644
--- a/src/LambdaCube/Compiler/DesugaredSource.hs
+++ b/src/LambdaCube/Compiler/DesugaredSource.hs
@@ -22,7 +22,6 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.IntMap as IM
 import Control.Arrow hiding ((<+>))
-import Control.DeepSeq
 
 import LambdaCube.Compiler.Utils
 import LambdaCube.Compiler.DeBruijn
@@ -88,9 +87,6 @@ showPos n p = pShow n <> ":" <> pShow p
 data Range = Range !FileInfo !SPos !SPos
     deriving (Eq, Ord)
 
-instance NFData Range where
-    rnf Range{} = ()
-
 instance Show Range where show = ppShow
 instance PShow Range
   where
@@ -111,11 +107,6 @@ data SI
 getRange (RangeSI r) = Just r
 getRange _ = Nothing
 
-instance NFData SI where
-    rnf = \case
-        NoSI x -> rnf x
-        RangeSI r -> rnf r
-
 --instance Show SI where show _ = "SI"
 instance Eq SI where _ == _ = True
 instance Ord SI where _ `compare` _ = EQ
@@ -202,11 +193,16 @@ data FNameTag
                     | FRecordCons
                     | FRecItem
                     | FSx | FSy | FSz | FSw
-    -- type constructors
-    | F'Int | F'Word | F'Float | F'String | F'Char | F'Output
+    | F'Int
+    | F'Word
+    | F'Float
+    | F'String
+    | F'Char
+    | F'Output
+    -- type functions
+    | F'T2 | F'EqCT | F'CW | F'Split | F'VecScalar
     -- functions
     | Fcoe | FparEval | Ft2C | FprimFix
-    | F'T2 | F'EqCT | F'CW | F'Split | F'VecScalar
     | Fparens | FtypeAnn | Fundefined | Fotherwise | FprimIfThenElse | FfromTo | FconcatMap | FfromInt | Fproject | Fswizzscalar | Fswizzvector
     -- other
     | F_rhs | F_section
diff --git a/src/LambdaCube/Compiler/InferMonad.hs b/src/LambdaCube/Compiler/InferMonad.hs
index 3e0aa980..b084647f 100644
--- a/src/LambdaCube/Compiler/InferMonad.hs
+++ b/src/LambdaCube/Compiler/InferMonad.hs
@@ -24,7 +24,6 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Arrow hiding ((<+>))
-import Control.DeepSeq
 
 --import LambdaCube.Compiler.Utils
 import LambdaCube.Compiler.DeBruijn
@@ -41,14 +40,6 @@ data ErrorMsg
     | ETypeError Doc SI
     | ERedefined SName SI SI
 
-instance NFData ErrorMsg where rnf = rnf . ppShow
-{-
-    rnf = \case
-        ErrorMsg m -> rnf m
-        ECantFind a b -> rnf (a, b)
-        ETypeError a b -> rnf (a, b)
-        ERedefined a b c -> rnf (a, b, c)
--}
 errorRange_ = \case
     ErrorMsg s -> []
     ECantFind s si -> [si]
@@ -72,16 +63,6 @@ data Info
     | IError ErrorMsg
     | ParseWarning ParseWarning
 
-instance NFData Info where rnf = rnf . ppShow
-{-
- where
-    rnf = \case
-        Info r s -> rnf (r, s)
-        IType a b -> rnf (a, b)
-        ITrace i s -> rnf (i, s)
-        IError x -> rnf x
-        ParseWarning w -> rnf w
--}
 instance PShow Info where
     pShow = \case
         Info r s -> nest 4 $ shortForm (pShow r) <$$> s
diff --git a/src/LambdaCube/Compiler/Parser.hs b/src/LambdaCube/Compiler/Parser.hs
index 154f5c7a..db059fcb 100644
--- a/src/LambdaCube/Compiler/Parser.hs
+++ b/src/LambdaCube/Compiler/Parser.hs
@@ -27,7 +27,6 @@ import Control.Monad.Writer
 import Control.Monad.RWS
 import Control.Arrow hiding ((<+>))
 import Control.Applicative
-import Control.DeepSeq
 
 import LambdaCube.Compiler.Utils
 import LambdaCube.Compiler.DeBruijn
@@ -56,12 +55,6 @@ data ParseWarning
     = Unreachable Range
     | Uncovered SIName [PatList]
 
-instance NFData ParseWarning
- where
-    rnf = \case
-        Unreachable r -> rnf r
-        Uncovered si r -> () --rnf si -- TODO --rnf r
-
 instance PShow LCParseError where
     pShow = \case
         MultiplePatternVars xs -> vcat $ "multiple pattern vars:":
diff --git a/src/LambdaCube/Compiler/Pretty.hs b/src/LambdaCube/Compiler/Pretty.hs
index 204e4893..0dd09107 100644
--- a/src/LambdaCube/Compiler/Pretty.hs
+++ b/src/LambdaCube/Compiler/Pretty.hs
@@ -24,7 +24,6 @@ import Control.Monad.Identity
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Arrow hiding ((<+>))
-import Control.DeepSeq
 import Debug.Trace
 
 import qualified Text.PrettyPrint.ANSI.Leijen as P
@@ -96,9 +95,6 @@ instance Monoid Doc where
     mempty = text ""
     mappend = dTwo mappend
 
-instance NFData Doc where
-    rnf x = rnf $ show x    -- TODO
-
 instance Show Doc where
     show = ($ "") . P.displayS . P.renderPretty 0.4 200 . renderDoc
 
diff --git a/src/LambdaCube/Compiler/Utils.hs b/src/LambdaCube/Compiler/Utils.hs
index 334abe08..5ec3815c 100644
--- a/src/LambdaCube/Compiler/Utils.hs
+++ b/src/LambdaCube/Compiler/Utils.hs
@@ -10,7 +10,7 @@ module LambdaCube.Compiler.Utils where
 import qualified Data.IntSet as IS
 import qualified Data.Text as T
 import qualified Text.Show.Pretty as PP
-import Control.Monad.Catch
+--import Control.Monad.Catch
 import Control.Monad.Except
 import Control.Monad.RWS
 import System.Directory
@@ -110,11 +110,11 @@ readFileIfExists fname = do
     return $ if b then Just $ readFileStrict fname else Nothing
 
 ------------------------------------------------------- missing instances
-
+{-
 instance MonadMask m => MonadMask (ExceptT e m) where
     mask f = ExceptT $ mask $ \u -> runExceptT $ f (mapExceptT u)
     uninterruptibleMask = error "not implemented: uninterruptibleMask for ExcpetT"
-
+-}
 instance (Monoid w, P.MonadParsec st m t) => P.MonadParsec st (RWST r w s m) t where
     failure                     = lift . P.failure
     label                       = mapRWST . P.label