diff options
author | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 22:34:36 +0200 |
---|---|---|
committer | Péter Diviánszky <divipp@gmail.com> | 2016-05-12 22:34:36 +0200 |
commit | 5e8656f3e3f169c62defc2d8573c66a679c4757e (patch) | |
tree | dcef816f86976dac319faeede3c40de0abeb689d /src | |
parent | 4460e137aaea9edf282de7e363f12507eacdc8a4 (diff) |
remove deepseq from compiler lib dependencies
Diffstat (limited to 'src')
-rw-r--r-- | src/LambdaCube/Compiler.hs | 9 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/DesugaredSource.hs | 20 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/InferMonad.hs | 19 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Parser.hs | 7 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Pretty.hs | 4 | ||||
-rw-r--r-- | src/LambdaCube/Compiler/Utils.hs | 6 |
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 | |||
14 | 14 | ||
15 | , MMT, runMMT, mapMMT | 15 | , MMT, runMMT, mapMMT |
16 | , MM, runMM | 16 | , MM, runMM |
17 | , catchErr | ||
18 | , ioFetch, decideFilePath | 17 | , ioFetch, decideFilePath |
19 | , loadModule, getDef, compileMain, parseModule, preCompile | 18 | , loadModule, getDef, compileMain, parseModule, preCompile |
20 | , removeFromCache | 19 | , removeFromCache |
@@ -35,9 +34,7 @@ import Control.Monad.State.Strict | |||
35 | import Control.Monad.Reader | 34 | import Control.Monad.Reader |
36 | import Control.Monad.Writer | 35 | import Control.Monad.Writer |
37 | import Control.Monad.Except | 36 | import Control.Monad.Except |
38 | import Control.DeepSeq | ||
39 | import Control.Monad.Catch | 37 | import Control.Monad.Catch |
40 | import Control.Exception hiding (catch, bracket, finally, mask) | ||
41 | import Control.Arrow hiding ((<+>)) | 38 | import Control.Arrow hiding ((<+>)) |
42 | import System.FilePath | 39 | import System.FilePath |
43 | --import Debug.Trace | 40 | --import Debug.Trace |
@@ -117,12 +114,6 @@ runMM fetcher | |||
117 | . flip runReaderT fetcher | 114 | . flip runReaderT fetcher |
118 | . runMMT | 115 | . runMMT |
119 | 116 | ||
120 | catchErr :: (MonadCatch m, NFData a, MonadIO m) => (String -> m a) -> m a -> m a | ||
121 | catchErr er m = (force <$> m >>= liftIO . evaluate) `catch` getErr `catch` getPMatchFail | ||
122 | where | ||
123 | getErr (e :: ErrorCall) = catchErr er $ er $ show e | ||
124 | getPMatchFail (e :: PatternMatchFail) = catchErr er $ er $ show e | ||
125 | |||
126 | -- TODO: remove dependent modules from cache too? | 117 | -- TODO: remove dependent modules from cache too? |
127 | removeFromCache :: Monad m => FilePath -> MMT m x () | 118 | removeFromCache :: Monad m => FilePath -> MMT m x () |
128 | removeFromCache f = modify $ \m@(Modules nm im ni) -> case Map.lookup f nm of | 119 | 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 | |||
22 | import qualified Data.Set as Set | 22 | import qualified Data.Set as Set |
23 | import qualified Data.IntMap as IM | 23 | import qualified Data.IntMap as IM |
24 | import Control.Arrow hiding ((<+>)) | 24 | import Control.Arrow hiding ((<+>)) |
25 | import Control.DeepSeq | ||
26 | 25 | ||
27 | import LambdaCube.Compiler.Utils | 26 | import LambdaCube.Compiler.Utils |
28 | import LambdaCube.Compiler.DeBruijn | 27 | import LambdaCube.Compiler.DeBruijn |
@@ -88,9 +87,6 @@ showPos n p = pShow n <> ":" <> pShow p | |||
88 | data Range = Range !FileInfo !SPos !SPos | 87 | data Range = Range !FileInfo !SPos !SPos |
89 | deriving (Eq, Ord) | 88 | deriving (Eq, Ord) |
90 | 89 | ||
91 | instance NFData Range where | ||
92 | rnf Range{} = () | ||
93 | |||
94 | instance Show Range where show = ppShow | 90 | instance Show Range where show = ppShow |
95 | instance PShow Range | 91 | instance PShow Range |
96 | where | 92 | where |
@@ -111,11 +107,6 @@ data SI | |||
111 | getRange (RangeSI r) = Just r | 107 | getRange (RangeSI r) = Just r |
112 | getRange _ = Nothing | 108 | getRange _ = Nothing |
113 | 109 | ||
114 | instance NFData SI where | ||
115 | rnf = \case | ||
116 | NoSI x -> rnf x | ||
117 | RangeSI r -> rnf r | ||
118 | |||
119 | --instance Show SI where show _ = "SI" | 110 | --instance Show SI where show _ = "SI" |
120 | instance Eq SI where _ == _ = True | 111 | instance Eq SI where _ == _ = True |
121 | instance Ord SI where _ `compare` _ = EQ | 112 | instance Ord SI where _ `compare` _ = EQ |
@@ -202,11 +193,16 @@ data FNameTag | |||
202 | | FRecordCons | 193 | | FRecordCons |
203 | | FRecItem | 194 | | FRecItem |
204 | | FSx | FSy | FSz | FSw | 195 | | FSx | FSy | FSz | FSw |
205 | -- type constructors | 196 | | F'Int |
206 | | F'Int | F'Word | F'Float | F'String | F'Char | F'Output | 197 | | F'Word |
198 | | F'Float | ||
199 | | F'String | ||
200 | | F'Char | ||
201 | | F'Output | ||
202 | -- type functions | ||
203 | | F'T2 | F'EqCT | F'CW | F'Split | F'VecScalar | ||
207 | -- functions | 204 | -- functions |
208 | | Fcoe | FparEval | Ft2C | FprimFix | 205 | | Fcoe | FparEval | Ft2C | FprimFix |
209 | | F'T2 | F'EqCT | F'CW | F'Split | F'VecScalar | ||
210 | | Fparens | FtypeAnn | Fundefined | Fotherwise | FprimIfThenElse | FfromTo | FconcatMap | FfromInt | Fproject | Fswizzscalar | Fswizzvector | 206 | | Fparens | FtypeAnn | Fundefined | Fotherwise | FprimIfThenElse | FfromTo | FconcatMap | FfromInt | Fproject | Fswizzscalar | Fswizzvector |
211 | -- other | 207 | -- other |
212 | | F_rhs | F_section | 208 | | 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 | |||
24 | import Control.Monad.Reader | 24 | import Control.Monad.Reader |
25 | import Control.Monad.Writer | 25 | import Control.Monad.Writer |
26 | import Control.Arrow hiding ((<+>)) | 26 | import Control.Arrow hiding ((<+>)) |
27 | import Control.DeepSeq | ||
28 | 27 | ||
29 | --import LambdaCube.Compiler.Utils | 28 | --import LambdaCube.Compiler.Utils |
30 | import LambdaCube.Compiler.DeBruijn | 29 | import LambdaCube.Compiler.DeBruijn |
@@ -41,14 +40,6 @@ data ErrorMsg | |||
41 | | ETypeError Doc SI | 40 | | ETypeError Doc SI |
42 | | ERedefined SName SI SI | 41 | | ERedefined SName SI SI |
43 | 42 | ||
44 | instance NFData ErrorMsg where rnf = rnf . ppShow | ||
45 | {- | ||
46 | rnf = \case | ||
47 | ErrorMsg m -> rnf m | ||
48 | ECantFind a b -> rnf (a, b) | ||
49 | ETypeError a b -> rnf (a, b) | ||
50 | ERedefined a b c -> rnf (a, b, c) | ||
51 | -} | ||
52 | errorRange_ = \case | 43 | errorRange_ = \case |
53 | ErrorMsg s -> [] | 44 | ErrorMsg s -> [] |
54 | ECantFind s si -> [si] | 45 | ECantFind s si -> [si] |
@@ -72,16 +63,6 @@ data Info | |||
72 | | IError ErrorMsg | 63 | | IError ErrorMsg |
73 | | ParseWarning ParseWarning | 64 | | ParseWarning ParseWarning |
74 | 65 | ||
75 | instance NFData Info where rnf = rnf . ppShow | ||
76 | {- | ||
77 | where | ||
78 | rnf = \case | ||
79 | Info r s -> rnf (r, s) | ||
80 | IType a b -> rnf (a, b) | ||
81 | ITrace i s -> rnf (i, s) | ||
82 | IError x -> rnf x | ||
83 | ParseWarning w -> rnf w | ||
84 | -} | ||
85 | instance PShow Info where | 66 | instance PShow Info where |
86 | pShow = \case | 67 | pShow = \case |
87 | Info r s -> nest 4 $ shortForm (pShow r) <$$> s | 68 | 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 | |||
27 | import Control.Monad.RWS | 27 | import Control.Monad.RWS |
28 | import Control.Arrow hiding ((<+>)) | 28 | import Control.Arrow hiding ((<+>)) |
29 | import Control.Applicative | 29 | import Control.Applicative |
30 | import Control.DeepSeq | ||
31 | 30 | ||
32 | import LambdaCube.Compiler.Utils | 31 | import LambdaCube.Compiler.Utils |
33 | import LambdaCube.Compiler.DeBruijn | 32 | import LambdaCube.Compiler.DeBruijn |
@@ -56,12 +55,6 @@ data ParseWarning | |||
56 | = Unreachable Range | 55 | = Unreachable Range |
57 | | Uncovered SIName [PatList] | 56 | | Uncovered SIName [PatList] |
58 | 57 | ||
59 | instance NFData ParseWarning | ||
60 | where | ||
61 | rnf = \case | ||
62 | Unreachable r -> rnf r | ||
63 | Uncovered si r -> () --rnf si -- TODO --rnf r | ||
64 | |||
65 | instance PShow LCParseError where | 58 | instance PShow LCParseError where |
66 | pShow = \case | 59 | pShow = \case |
67 | MultiplePatternVars xs -> vcat $ "multiple pattern vars:": | 60 | 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 | |||
24 | import Control.Monad.Reader | 24 | import Control.Monad.Reader |
25 | import Control.Monad.State | 25 | import Control.Monad.State |
26 | import Control.Arrow hiding ((<+>)) | 26 | import Control.Arrow hiding ((<+>)) |
27 | import Control.DeepSeq | ||
28 | import Debug.Trace | 27 | import Debug.Trace |
29 | 28 | ||
30 | import qualified Text.PrettyPrint.ANSI.Leijen as P | 29 | import qualified Text.PrettyPrint.ANSI.Leijen as P |
@@ -96,9 +95,6 @@ instance Monoid Doc where | |||
96 | mempty = text "" | 95 | mempty = text "" |
97 | mappend = dTwo mappend | 96 | mappend = dTwo mappend |
98 | 97 | ||
99 | instance NFData Doc where | ||
100 | rnf x = rnf $ show x -- TODO | ||
101 | |||
102 | instance Show Doc where | 98 | instance Show Doc where |
103 | show = ($ "") . P.displayS . P.renderPretty 0.4 200 . renderDoc | 99 | show = ($ "") . P.displayS . P.renderPretty 0.4 200 . renderDoc |
104 | 100 | ||
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 | |||
10 | import qualified Data.IntSet as IS | 10 | import qualified Data.IntSet as IS |
11 | import qualified Data.Text as T | 11 | import qualified Data.Text as T |
12 | import qualified Text.Show.Pretty as PP | 12 | import qualified Text.Show.Pretty as PP |
13 | import Control.Monad.Catch | 13 | --import Control.Monad.Catch |
14 | import Control.Monad.Except | 14 | import Control.Monad.Except |
15 | import Control.Monad.RWS | 15 | import Control.Monad.RWS |
16 | import System.Directory | 16 | import System.Directory |
@@ -110,11 +110,11 @@ readFileIfExists fname = do | |||
110 | return $ if b then Just $ readFileStrict fname else Nothing | 110 | return $ if b then Just $ readFileStrict fname else Nothing |
111 | 111 | ||
112 | ------------------------------------------------------- missing instances | 112 | ------------------------------------------------------- missing instances |
113 | 113 | {- | |
114 | instance MonadMask m => MonadMask (ExceptT e m) where | 114 | instance MonadMask m => MonadMask (ExceptT e m) where |
115 | mask f = ExceptT $ mask $ \u -> runExceptT $ f (mapExceptT u) | 115 | mask f = ExceptT $ mask $ \u -> runExceptT $ f (mapExceptT u) |
116 | uninterruptibleMask = error "not implemented: uninterruptibleMask for ExcpetT" | 116 | uninterruptibleMask = error "not implemented: uninterruptibleMask for ExcpetT" |
117 | 117 | -} | |
118 | instance (Monoid w, P.MonadParsec st m t) => P.MonadParsec st (RWST r w s m) t where | 118 | instance (Monoid w, P.MonadParsec st m t) => P.MonadParsec st (RWST r w s m) t where |
119 | failure = lift . P.failure | 119 | failure = lift . P.failure |
120 | label = mapRWST . P.label | 120 | label = mapRWST . P.label |