1cdc9dd · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Reduce space leak through ugly DeepSeq hack

1cdc9ddDavid Raymond Christiansen11 years ago

src/Idris/Core/DeepSeq.hs+43

compare with master

unifiedsplit

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns, ViewPatterns #-}

1{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

2{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

3module Idris.Core.DeepSeq where

4module Idris.Core.DeepSeq where

@@ -16,6 +17,48 @@ instance NFData Name where

16 rnf (SN x1) = rnf x1 `seq` ()

17 rnf (SN x1) = rnf x1 `seq` ()

17 rnf (SymRef x1) = rnf x1 `seq` ()

18 rnf (SymRef x1) = rnf x1 `seq` ()

20+instance NFData Context where

21+ rnf ctxt = rnf (next_tvar ctxt) `seq` rnf (definitions ctxt) `seq` ()

22+

23+-- | Forcing the contents of a context, for diagnosing and working

24+-- around space leaks

25+forceDefCtxt :: Context -> Context

26+forceDefCtxt (force -> !ctxt) = ctxt

27+

28+instance NFData NameOutput where

29+ rnf TypeOutput = ()

30+ rnf FunOutput = ()

31+ rnf DataOutput = ()

32+ rnf MetavarOutput = ()

33+ rnf PostulateOutput = ()

34+

35+instance NFData TextFormatting where

36+ rnf BoldText = ()

37+ rnf ItalicText = ()

38+ rnf UnderlineText = ()

39+

40+instance NFData Ordering where

41+ rnf LT = ()

42+ rnf EQ = ()

43+ rnf GT = ()

44+

45+instance NFData OutputAnnotation where

46+ rnf (AnnName x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()

47+ rnf (AnnBoundName x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

48+ rnf (AnnConst x1) = rnf x1 `seq` ()

49+ rnf (AnnData x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

50+ rnf (AnnType x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

51+ rnf (AnnKeyword) = ()

52+ rnf (AnnFC x) = rnf x `seq` ()

53+ rnf (AnnTextFmt x) = rnf x `seq` ()

54+ rnf (AnnLink x) = rnf x `seq` ()

55+ rnf (AnnTerm x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

56+ rnf (AnnSearchResult x1) = rnf x1 `seq` ()

57+ rnf (AnnErr x1) = rnf x1 `seq` ()

58+ rnf (AnnNamespace x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

59+ rnf (AnnQuasiquote) = ()

60+ rnf (AnnAntiquote) = ()

61+

19instance NFData SpecialName where

62instance NFData SpecialName where

20 rnf (WhereN x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()

63 rnf (WhereN x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()

21 rnf (WithN x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

64 rnf (WithN x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

src/Idris/Core/Evaluate.hs+13−11

@@ -1,4 +1,4 @@

1−{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,

1+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, BangPatterns,

2 PatternGuards #-}

3{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}

@@ -802,12 +802,14 @@ data Context = MkContext {

802 definitions :: Ctxt (Def, Accessibility, Totality, MetaInformation)

803 } deriving Show

804

805+

805-- | The initial empty context

806-- | The initial empty context

806initContext = MkContext 0 emptyContext

807initContext = MkContext 0 emptyContext

807

808

809+

808mapDefCtxt :: (Def -> Def) -> Context -> Context

810mapDefCtxt :: (Def -> Def) -> Context -> Context

809−mapDefCtxt f (MkContext t defs) = MkContext t (mapCtxt f' defs)

811+mapDefCtxt f (MkContext t !defs) = MkContext t (mapCtxt f' defs)

810− where f' (d, a, t, m) = f' (f d, a, t, m)

812+ where f' (!d, a, t, m) = f' (f d, a, t, m)

811

813

812-- | Get the definitions from a context

814-- | Get the definitions from a context

813ctxtAlist :: Context -> [(Name, Def)]

815ctxtAlist :: Context -> [(Name, Def)]

@@ -818,44 +820,44 @@ veval ctxt env t = evalState (eval False ctxt [] env t []) initEval

818addToCtxt :: Name -> Term -> Type -> Context -> Context

820addToCtxt :: Name -> Term -> Type -> Context -> Context

819addToCtxt n tm ty uctxt

821addToCtxt n tm ty uctxt

820 = let ctxt = definitions uctxt

822 = let ctxt = definitions uctxt

821− ctxt' = addDef n (Function ty tm, Public, Unchecked, EmptyMI) ctxt in

823+ !ctxt' = addDef n (Function ty tm, Public, Unchecked, EmptyMI) ctxt in

822 uctxt { definitions = ctxt' }

824 uctxt { definitions = ctxt' }

823

825

824setAccess :: Name -> Accessibility -> Context -> Context

826setAccess :: Name -> Accessibility -> Context -> Context

825setAccess n a uctxt

827setAccess n a uctxt

826 = let ctxt = definitions uctxt

828 = let ctxt = definitions uctxt

827− ctxt' = updateDef n (\ (d, _, t, m) -> (d, a, t, m)) ctxt in

829+ !ctxt' = updateDef n (\ (d, _, t, m) -> (d, a, t, m)) ctxt in

828 uctxt { definitions = ctxt' }

830 uctxt { definitions = ctxt' }

829

831

830setTotal :: Name -> Totality -> Context -> Context

832setTotal :: Name -> Totality -> Context -> Context

831setTotal n t uctxt

833setTotal n t uctxt

832 = let ctxt = definitions uctxt

834 = let ctxt = definitions uctxt

833− ctxt' = updateDef n (\ (d, a, _, m) -> (d, a, t, m)) ctxt in

835+ !ctxt' = updateDef n (\ (d, a, _, m) -> (d, a, t, m)) ctxt in

834 uctxt { definitions = ctxt' }

836 uctxt { definitions = ctxt' }

835

837

836setMetaInformation :: Name -> MetaInformation -> Context -> Context

838setMetaInformation :: Name -> MetaInformation -> Context -> Context

837setMetaInformation n m uctxt

839setMetaInformation n m uctxt

838 = let ctxt = definitions uctxt

840 = let ctxt = definitions uctxt

839− ctxt' = updateDef n (\ (d, a, t, _) -> (d, a, t, m)) ctxt in

841+ !ctxt' = updateDef n (\ (d, a, t, _) -> (d, a, t, m)) ctxt in

840 uctxt { definitions = ctxt' }

842 uctxt { definitions = ctxt' }

841

843

842addCtxtDef :: Name -> Def -> Context -> Context

844addCtxtDef :: Name -> Def -> Context -> Context

843addCtxtDef n d c = let ctxt = definitions c

845addCtxtDef n d c = let ctxt = definitions c

844− ctxt' = addDef n (d, Public, Unchecked, EmptyMI) $! ctxt in

846+ !ctxt' = addDef n (d, Public, Unchecked, EmptyMI) $! ctxt in

845 c { definitions = ctxt' }

847 c { definitions = ctxt' }

846

848

847addTyDecl :: Name -> NameType -> Type -> Context -> Context

849addTyDecl :: Name -> NameType -> Type -> Context -> Context

848addTyDecl n nt ty uctxt

850addTyDecl n nt ty uctxt

849 = let ctxt = definitions uctxt

851 = let ctxt = definitions uctxt

850− ctxt' = addDef n (TyDecl nt ty, Public, Unchecked, EmptyMI) ctxt in

852+ !ctxt' = addDef n (TyDecl nt ty, Public, Unchecked, EmptyMI) ctxt in

851 uctxt { definitions = ctxt' }

853 uctxt { definitions = ctxt' }

852

854

853addDatatype :: Datatype Name -> Context -> Context

855addDatatype :: Datatype Name -> Context -> Context

854addDatatype (Data n tag ty unique cons) uctxt

856addDatatype (Data n tag ty unique cons) uctxt

855 = let ctxt = definitions uctxt

857 = let ctxt = definitions uctxt

856 ty' = normalise uctxt [] ty

858 ty' = normalise uctxt [] ty

857− ctxt' = addCons 0 cons (addDef n

859+ !ctxt' = addCons 0 cons (addDef n

858− (TyDecl (TCon tag (arity ty')) ty, Public, Unchecked, EmptyMI) ctxt) in

860+ (TyDecl (TCon tag (arity ty')) ty, Public, Unchecked, EmptyMI) ctxt) in

859 uctxt { definitions = ctxt' }

861 uctxt { definitions = ctxt' }

860 where

862 where

861 addCons tag [] ctxt = ctxt

863 addCons tag [] ctxt = ctxt

src/Idris/Core/TT.hs+15−14

@@ -51,6 +51,7 @@ import Prelude (Eq(..), Show(..), Ord(..), Functor(..), Monad(..), String, Int,

52import Control.Applicative (Applicative (..), Alternative)

53import qualified Control.Applicative as A (Alternative (..))

54+import Control.DeepSeq (($!!))

54import Control.Monad.State.Strict

55import Control.Monad.State.Strict

55import Control.Monad.Trans.Except (Except (..))

56import Control.Monad.Trans.Except (Except (..))

56import Debug.Trace

57import Debug.Trace

@@ -438,11 +439,11 @@ traceWhen False _ a = a

438

439

439-- | Names are hierarchies of strings, describing scope (so no danger of

440-- | Names are hierarchies of strings, describing scope (so no danger of

440-- duplicate names, but need to be careful on lookup).

441-- duplicate names, but need to be careful on lookup).

441−data Name = UN T.Text -- ^ User-provided name

442+data Name = UN !T.Text -- ^ User-provided name

442− | NS Name [T.Text] -- ^ Root, namespaces

443+ | NS !Name [T.Text] -- ^ Root, namespaces

443− | MN Int T.Text -- ^ Machine chosen names

444+ | MN !Int !T.Text -- ^ Machine chosen names

444 | NErased -- ^ Name of something which is never used in scope

445 | NErased -- ^ Name of something which is never used in scope

445− | SN SpecialName -- ^ Decorated function names

446+ | SN !SpecialName -- ^ Decorated function names

446 | SymRef Int -- ^ Reference to IBC file symbol table (used during serialisation)

447 | SymRef Int -- ^ Reference to IBC file symbol table (used during serialisation)

447 deriving (Eq, Ord, Data, Typeable)

448 deriving (Eq, Ord, Data, Typeable)

448

449

@@ -463,7 +464,7 @@ sUN :: String -> Name

463sUN s = UN (txt s)

464sUN s = UN (txt s)

464

465

465sNS :: Name -> [String] -> Name

466sNS :: Name -> [String] -> Name

466−sNS n ss = NS n (map txt ss)

467+sNS n ss = NS n $!! (map txt ss)

467

468

468sMN :: Int -> String -> Name

469sMN :: Int -> String -> Name

469sMN i s = MN i (txt s)

470sMN i s = MN i (txt s)

@@ -473,15 +474,15 @@ deriving instance Binary Name

473deriving instance NFData Name

474deriving instance NFData Name

474!-}

475!-}

475

476

476−data SpecialName = WhereN Int Name Name

477+data SpecialName = WhereN !Int !Name !Name

477− | WithN Int Name

478+ | WithN !Int !Name

478− | InstanceN Name [T.Text]

479+ | InstanceN !Name [T.Text]

479− | ParentN Name T.Text

480+ | ParentN !Name !T.Text

480− | MethodN Name

481+ | MethodN !Name

481− | CaseN Name

482+ | CaseN !Name

482− | ElimN Name

483+ | ElimN !Name

483− | InstanceCtorN Name

484+ | InstanceCtorN !Name

484− | MetaN Name Name

485+ | MetaN !Name !Name

485 deriving (Eq, Ord, Data, Typeable)

486 deriving (Eq, Ord, Data, Typeable)

486{-!

487{-!

487deriving instance Binary SpecialName

488deriving instance Binary SpecialName

src/Idris/DeepSeq.hs+294

@@ -6,6 +6,10 @@ import Idris.Core.DeepSeq

6import Idris.Docstrings

7import Idris.Core.TT

8import Idris.AbsSyntaxTree

9+import Idris.Colours

10+import IRTS.Lang (PrimFn(..))

11+import IRTS.CodegenCommon (OutputType (..))

12+import Util.DynamicLinker

10import Control.DeepSeq

14import Control.DeepSeq

@@ -18,6 +22,281 @@ instance NFData a => NFData (D.Docstring a) where

18instance NFData CT.Options where

22instance NFData CT.Options where

19 rnf (CT.Options x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()

23 rnf (CT.Options x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()

25+instance NFData ConsoleWidth where

26+ rnf InfinitelyWide = ()

27+ rnf (ColsWide x) = rnf x `seq` ()

28+ rnf AutomaticWidth = ()

29+

30+instance NFData PrimFn where

31+ rnf (LPlus x) = rnf x `seq` ()

32+ rnf (LMinus x) = rnf x `seq` ()

33+ rnf (LTimes x) = rnf x `seq` ()

34+ rnf (LUDiv x) = rnf x `seq` ()

35+ rnf (LSDiv x) = rnf x `seq` ()

36+ rnf (LURem x) = rnf x `seq` ()

37+ rnf (LSRem x) = rnf x `seq` ()

38+ rnf (LAnd x) = rnf x `seq` ()

39+ rnf (LOr x) = rnf x `seq` ()

40+ rnf (LXOr x) = rnf x `seq` ()

41+ rnf (LCompl x) = rnf x `seq` ()

42+ rnf (LSHL x) = rnf x `seq` ()

43+ rnf (LLSHR x) = rnf x `seq` ()

44+ rnf (LASHR x) = rnf x `seq` ()

45+ rnf (LEq x) = rnf x `seq` ()

46+ rnf (LLt x) = rnf x `seq` ()

47+ rnf (LLe x) = rnf x `seq` ()

48+ rnf (LGt x) = rnf x `seq` ()

49+ rnf (LGe x) = rnf x `seq` ()

50+ rnf (LSLt x) = rnf x `seq` ()

51+ rnf (LSLe x) = rnf x `seq` ()

52+ rnf (LSGt x) = rnf x `seq` ()

53+ rnf (LSGe x) = rnf x `seq` ()

54+ rnf (LSExt x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

55+ rnf (LZExt x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

56+ rnf (LTrunc x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

57+ rnf (LStrConcat) = ()

58+ rnf (LStrLt) = ()

59+ rnf (LStrEq) = ()

60+ rnf (LStrLen) = ()

61+ rnf (LIntFloat x) = rnf x `seq` ()

62+ rnf (LFloatInt x) = rnf x `seq` ()

63+ rnf (LIntStr x) = rnf x `seq` ()

64+ rnf (LStrInt x) = rnf x `seq` ()

65+ rnf (LFloatStr) = ()

66+ rnf (LStrFloat) = ()

67+ rnf (LChInt x) = rnf x `seq` ()

68+ rnf (LIntCh x) = rnf x `seq` ()

69+ rnf (LBitCast x1 x2) = rnf x1 `seq` rnf x2 `seq` ()

70+ rnf (LFExp) = ()

71+ rnf (LFLog) = ()

72+ rnf (LFSin) = ()

73+ rnf (LFCos) = ()

74+ rnf (LFTan) = ()

75+ rnf (LFASin) = ()

76+ rnf (LFACos) = ()

77+ rnf (LFATan) = ()

78+ rnf (LFSqrt) = ()

79+ rnf (LFFloor) = ()

80+ rnf (LFCeil) = ()

81+ rnf (LFNegate) = ()

82+ rnf (LStrHead) = ()

83+ rnf (LStrTail) = ()

84+ rnf (LStrCons) = ()

85+ rnf (LStrIndex) = ()

86+ rnf (LStrRev) = ()

87+ rnf (LReadStr) = ()

88+ rnf (LWriteStr) = ()

89+ rnf (LSystemInfo) = ()

90+ rnf (LFork) = ()

91+ rnf (LPar) = ()

92+ rnf (LExternal x) = rnf x `seq` ()

93+ rnf (LNoOp) = ()

94+

95+instance NFData SyntaxRules where

96+ rnf (SyntaxRules xs) = rnf xs `seq` ()

97+

98+instance NFData DynamicLib where

99+ rnf (Lib x _) = rnf x `seq` ()

100+

101+

102+instance NFData Opt where

103+ rnf (Filename str) = rnf str `seq` ()

104+ rnf (Quiet) = ()

105+ rnf (NoBanner) = ()

106+ rnf (ColourREPL bool) = rnf bool `seq` ()

107+ rnf (Idemode) = ()

108+ rnf (IdemodeSocket) = ()

109+ rnf (ShowLibs) = ()

110+ rnf (ShowLibdir) = ()

111+ rnf (ShowIncs) = ()

112+ rnf (ShowPkgs) = ()

113+ rnf (NoBasePkgs) = ()

114+ rnf (NoPrelude) = ()

115+ rnf (NoBuiltins) = ()

116+ rnf (NoREPL) = ()

117+ rnf (OLogging i) = rnf i `seq` ()

118+ rnf (Output str) = rnf str `seq` ()

119+ rnf (Interface) = ()

120+ rnf (TypeCase) = ()

121+ rnf (TypeInType) = ()

122+ rnf (DefaultTotal) = ()

123+ rnf (DefaultPartial) = ()

124+ rnf (WarnPartial) = ()

125+ rnf (WarnReach) = ()

126+ rnf (EvalTypes) = ()

127+ rnf (NoCoverage) = ()

128+ rnf (ErrContext) = ()

129+ rnf (ShowImpl) = ()

130+ rnf (Verbose) = ()

131+ rnf (Port str) = rnf str `seq` ()

132+ rnf (IBCSubDir str) = rnf str `seq` ()

133+ rnf (ImportDir str) = rnf str `seq` ()

134+ rnf (PkgBuild str) = rnf str `seq` ()

135+ rnf (PkgInstall str) = rnf str `seq` ()

136+ rnf (PkgClean str) = rnf str `seq` ()

137+ rnf (PkgCheck str) = rnf str `seq` ()

138+ rnf (PkgREPL str) = rnf str `seq` ()

139+ rnf (PkgMkDoc str) = rnf str `seq` ()

140+ rnf (PkgTest str) = rnf str `seq` ()

141+ rnf (PkgIndex fp) = rnf fp `seq` ()

142+ rnf (WarnOnly) = ()

143+ rnf (Pkg str) = rnf str `seq` ()

144+ rnf (BCAsm str) = rnf str `seq` ()

145+ rnf (DumpDefun str) = rnf str `seq` ()

146+ rnf (DumpCases str) = rnf str `seq` ()

147+ rnf (UseCodegen cg) = rnf cg `seq` ()

148+ rnf (CodegenArgs str) = rnf str `seq` ()

149+ rnf (OutputTy ot) = rnf ot `seq` ()

150+ rnf (Extension le) = rnf le `seq` ()

151+ rnf (InterpretScript str) = rnf str `seq` ()

152+ rnf (EvalExpr str) = rnf str `seq` ()

153+ rnf (TargetTriple str) = rnf str `seq` ()

154+ rnf (TargetCPU str) = rnf str `seq` ()

155+ rnf (OptLevel i) = rnf i `seq` ()

156+ rnf (AddOpt o) = rnf o `seq` ()

157+ rnf (RemoveOpt o) = rnf o `seq` ()

158+ rnf (Client str) = rnf str `seq` ()

159+ rnf (ShowOrigErr) = ()

160+ rnf (AutoWidth) = ()

161+ rnf (AutoSolve) = ()

162+ rnf (UseConsoleWidth cw) = rnf cw `seq` ()

163+ rnf (DumpHighlights) = ()

164+

165+

166+instance NFData TIData where

167+ rnf TIPartial = ()

168+ rnf (TISolution xs) = rnf xs `seq` ()

169+

170+instance NFData IOption where

171+ rnf (IOption

172+ opt_logLevel

173+ opt_typecase

174+ opt_typeintype

175+ opt_coverage

176+ opt_showimp

177+ opt_errContext

178+ opt_repl

179+ opt_verbose

180+ opt_nobanner

181+ opt_quiet

182+ opt_codegen

183+ opt_outputTy

184+ opt_ibcsubdir

185+ opt_importdirs

186+ opt_triple

187+ opt_cpu

188+ opt_cmdline

189+ opt_origerr

190+ opt_autoSolve

191+ opt_autoImport

192+ opt_optimise

193+ opt_printdepth

194+ opt_evaltypes) =

195+ rnf opt_logLevel

196+ `seq` rnf opt_typecase

197+ `seq` rnf opt_typeintype

198+ `seq` rnf opt_coverage

199+ `seq` rnf opt_showimp

200+ `seq` rnf opt_errContext

201+ `seq` rnf opt_repl

202+ `seq` rnf opt_verbose

203+ `seq` rnf opt_nobanner

204+ `seq` rnf opt_quiet

205+ `seq` rnf opt_codegen

206+ `seq` rnf opt_outputTy

207+ `seq` rnf opt_ibcsubdir

208+ `seq` rnf opt_importdirs

209+ `seq` rnf opt_triple

210+ `seq` rnf opt_cpu

211+ `seq` rnf opt_cmdline

212+ `seq` rnf opt_origerr

213+ `seq` rnf opt_autoSolve

214+ `seq` rnf opt_autoImport

215+ `seq` rnf opt_optimise

216+ `seq` rnf opt_printdepth

217+ `seq` rnf opt_evaltypes

218+ `seq` ()

219+

220+instance NFData LanguageExt where

221+ rnf TypeProviders = ()

222+ rnf ErrorReflection = ()

223+

224+instance NFData Optimisation where

225+ rnf PETransform = ()

226+

227+instance NFData ColourTheme where

228+ rnf (ColourTheme keywordColour

229+ boundVarColour

230+ implicitColour

231+ functionColour

232+ typeColour

233+ dataColour

234+ promptColour

235+ postulateColour) =

236+ rnf keywordColour

237+ `seq` rnf boundVarColour

238+ `seq` rnf implicitColour

239+ `seq` rnf functionColour

240+ `seq` rnf typeColour

241+ `seq` rnf dataColour

242+ `seq` rnf promptColour

243+ `seq` rnf postulateColour

244+ `seq` ()

245+

246+instance NFData IdrisColour where

247+ rnf (IdrisColour _ x2 x3 x4 x5) = rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()

248+

249+instance NFData OutputType where

250+ rnf Raw = ()

251+ rnf Object = ()

252+ rnf Executable = ()

253+ rnf MavenProject = ()

254+

255+instance NFData IBCWrite where

256+ rnf (IBCFix fixDecl) = rnf fixDecl `seq` ()

257+ rnf (IBCImp name) = rnf name `seq` ()

258+ rnf (IBCStatic name) = rnf name `seq` ()

259+ rnf (IBCClass name) = rnf name `seq` ()

260+ rnf (IBCInstance b1 b2 n1 n2) = rnf b1 `seq` rnf b2 `seq` rnf n1 `seq` rnf n2 `seq` ()

261+ rnf (IBCDSL name) = rnf name `seq` ()

262+ rnf (IBCData name) = rnf name `seq` ()

263+ rnf (IBCOpt name) = rnf name `seq` ()

264+ rnf (IBCMetavar name) = rnf name `seq` ()

265+ rnf (IBCSyntax syntax) = rnf syntax `seq` ()

266+ rnf (IBCKeyword string) = rnf string `seq` ()

267+ rnf (IBCImport imp) = rnf imp `seq` ()

268+ rnf (IBCImportDir filePath) = rnf filePath `seq` ()

269+ rnf (IBCObj codegen filePath) = rnf codegen `seq` rnf filePath `seq` ()

270+ rnf (IBCLib codegen string) = rnf codegen `seq` rnf string `seq` ()

271+ rnf (IBCCGFlag codegen string) = rnf codegen `seq` rnf string `seq` ()

272+ rnf (IBCDyLib string) = rnf string `seq` ()

273+ rnf (IBCHeader codegen string) = rnf codegen `seq` rnf string `seq` ()

274+ rnf (IBCAccess name accessibility) = rnf name `seq` rnf accessibility `seq` ()

275+ rnf (IBCMetaInformation name metaInformation) = rnf name `seq` rnf metaInformation `seq` ()

276+ rnf (IBCTotal name totality) = rnf name `seq` rnf totality `seq` ()

277+ rnf (IBCFlags name fnOpts) = rnf name `seq` rnf fnOpts `seq` ()

278+ rnf (IBCFnInfo name fnInfo) = rnf name `seq` rnf fnInfo `seq` ()

279+ rnf (IBCTrans name terms) = rnf name `seq` rnf terms `seq` ()

280+ rnf (IBCErrRev terms) = rnf terms `seq` ()

281+ rnf (IBCCG name) = rnf name `seq` ()

282+ rnf (IBCDoc name) = rnf name `seq` ()

283+ rnf (IBCCoercion name) = rnf name `seq` ()

284+ rnf (IBCDef name) = rnf name `seq` ()

285+ rnf (IBCNameHint names) = rnf names `seq` ()

286+ rnf (IBCLineApp filePath int pTerm) = rnf filePath `seq` rnf int `seq` rnf pTerm `seq` ()

287+ rnf (IBCErrorHandler name) = rnf name `seq` ()

288+ rnf (IBCFunctionErrorHandler n1 n2 n3) = rnf n1 `seq` rnf n2 `seq` rnf n3 `seq` ()

289+ rnf (IBCPostulate name) = rnf name `seq` ()

290+ rnf (IBCExtern extern) = rnf extern `seq` ()

291+ rnf (IBCTotCheckErr fc string) = rnf fc `seq` rnf string `seq` ()

292+ rnf (IBCParsedRegion fc) = rnf fc `seq` ()

293+ rnf (IBCModDocs name) = rnf name `seq` ()

294+ rnf (IBCUsage usage) = rnf usage `seq` ()

295+ rnf (IBCExport name) = rnf name `seq` ()

296+ rnf (IBCAutoHint n1 n2) = rnf n1 `seq` rnf n2 `seq` ()

297+ rnf (IBCRecord x) = rnf x `seq` ()

298+

299+

21instance NFData a => NFData (D.Block a) where

300instance NFData a => NFData (D.Block a) where

22 rnf (D.Para lines) = rnf lines `seq` ()

301 rnf (D.Para lines) = rnf lines `seq` ()

23 rnf (D.Header i lines) = rnf i `seq` rnf lines `seq` ()

302 rnf (D.Header i lines) = rnf i `seq` rnf lines `seq` ()

@@ -394,3 +673,18 @@ instance NFData SyntaxInfo where

394 rnf x4 `seq`

673 rnf x4 `seq`

395 rnf x5 `seq`

674 rnf x5 `seq`

396 rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` rnf x11 `seq` rnf x12 `seq` ()

675 rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` rnf x11 `seq` rnf x12 `seq` ()

676+

677+instance NFData OutputMode where

678+ rnf (RawOutput x) = () -- no instance for Handle, so this is a bit wrong

679+ rnf (IdeMode x y) = rnf x `seq` ()

680+

681+

682+instance NFData IState where

683+ rnf (IState x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20

684+ x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 x32 x33 x34 x35 x36 x37 x38 x39 x40

685+ x41 x42 x43 x44 x45 x46 x47 x48 x49 x50 x51 x52 x53 x54 x55 x56 x57 x58 x59 x60

686+ x61 x62 x63 x64 x65 x66 x67 x68 x69 x70 x71 x72 x73)

687+ = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` rnf x10 `seq` () `seq` rnf x11 `seq` rnf x12 `seq` rnf x13 `seq` rnf x14 `seq` rnf x15 `seq` rnf x16 `seq` rnf x17 `seq` rnf x18 `seq` rnf x19 `seq` rnf x20 `seq`

688+ rnf x21 `seq` rnf x22 `seq` rnf x23 `seq` rnf x24 `seq` rnf x25 `seq` rnf x26 `seq` rnf x27 `seq` rnf x28 `seq` rnf x29 `seq` rnf x30 `seq` rnf x31 `seq` rnf x32 `seq` rnf x33 `seq` rnf x34 `seq` rnf x35 `seq` rnf x36 `seq` rnf x37 `seq` rnf x38 `seq` rnf x39 `seq` rnf x40 `seq`

689+ rnf x41 `seq` rnf x42 `seq` rnf x43 `seq` rnf x44 `seq` rnf x45 `seq` rnf x46 `seq` rnf x47 `seq` rnf x48 `seq` rnf x49 `seq` rnf x50 `seq` rnf x51 `seq` rnf x52 `seq` rnf x53 `seq` rnf x54 `seq` rnf x55 `seq` rnf x56 `seq` rnf x57 `seq` rnf x58 `seq` rnf x59 `seq` rnf x60 `seq`

690+ rnf x61 `seq` rnf x62 `seq` rnf x63 `seq` rnf x64 `seq` rnf x65 `seq` rnf x66 `seq` rnf x67 `seq` rnf x68 `seq` rnf x69 `seq` rnf x70 `seq` rnf x71 `seq` rnf x72 `seq` rnf x73 `seq` ()

src/Idris/IBC.hs+1−1

@@ -309,7 +309,7 @@ ibc i (IBCAutoHint n h) f = return f { ibc_autohints = (n, h) : ibc_autohints f

309getEntry :: (Binary b, NFData b) => b -> FilePath -> Archive -> Idris b

310getEntry alt f a = case findEntryByPath f a of

311 Nothing -> return alt

312− Just e -> return $ (force . decode . fromEntry) e

312+ Just e -> return $! (force . decode . fromEntry) e

313

314process :: Bool -- ^ Reexporting

315 -> Archive -> FilePath -> Idris ()

src/Idris/REPL.hs+33−20

@@ -327,10 +327,13 @@ runIdeModeCommand h id orig fn mods (IdeMode.REPLCompletions str) =

327 reverse unused)]

328 runIO . hPutStrLn h $ IdeMode.convSExp "return" good id

329runIdeModeCommand h id orig fn mods (IdeMode.LoadFile filename toline) =

330+ -- The $!! here prevents a space leak on reloading.

331+ -- This isn't a solution - but it's a temporary stopgap.

332+ -- See issue #2386

330 do i <- getIState

333 do i <- getIState

331 clearErr

334 clearErr

332− putIState (orig { idris_options = idris_options i,

335+ putIState $!! orig { idris_options = idris_options i,

333− idris_outputmode = (IdeMode id h) })

336+ idris_outputmode = (IdeMode id h) }

334 mods <- loadInputs [filename] toline

337 mods <- loadInputs [filename] toline

335 isetPrompt (mkPrompt mods)

338 isetPrompt (mkPrompt mods)

336 -- Report either success or failure

339 -- Report either success or failure

@@ -686,17 +689,23 @@ processInput cmd orig inputs efile

686 Failure err -> do iputStrLn $ show (fixColour c err)

689 Failure err -> do iputStrLn $ show (fixColour c err)

687 return (Just inputs)

690 return (Just inputs)

688 Success (Right Reload) ->

691 Success (Right Reload) ->

692+ -- The $!! here prevents a space leak on reloading.

693+ -- This isn't a solution - but it's a temporary stopgap.

694+ -- See issue #2386

689− do putIState $ orig { idris_options = idris_options i

695+ do putIState $!! orig { idris_options = idris_options i

690− , idris_colourTheme = idris_colourTheme i

696+ , idris_colourTheme = idris_colourTheme i

691− , imported = imported i

697+ , imported = imported i

692− }

698+ }

693 clearErr

699 clearErr

694 mods <- loadInputs inputs Nothing

700 mods <- loadInputs inputs Nothing

695 return (Just mods)

701 return (Just mods)

696 Success (Right (Load f toline)) ->

702 Success (Right (Load f toline)) ->

703+ -- The $!! here prevents a space leak on reloading.

704+ -- This isn't a solution - but it's a temporary stopgap.

705+ -- See issue #2386

697− do putIState orig { idris_options = idris_options i

706+ do putIState $!! orig { idris_options = idris_options i

698− , idris_colourTheme = idris_colourTheme i

707+ , idris_colourTheme = idris_colourTheme i

699− }

708+ }

700 clearErr

709 clearErr

701 mod <- loadInputs [f] toline

710 mod <- loadInputs [f] toline

702 return (Just mod)

711 return (Just mod)

@@ -746,9 +755,9 @@ edit f orig

746 let args = line ++ [fixName f]

755 let args = line ++ [fixName f]

747 runIO $ rawSystem editor args

756 runIO $ rawSystem editor args

748 clearErr

757 clearErr

749− putIState $ orig { idris_options = idris_options i

758+ putIState $!! orig { idris_options = idris_options i

750− , idris_colourTheme = idris_colourTheme i

759+ , idris_colourTheme = idris_colourTheme i

751− }

760+ }

752 loadInputs [f] Nothing

761 loadInputs [f] Nothing

753-- clearOrigPats

762-- clearOrigPats

754 iucheck

763 iucheck

@@ -1510,13 +1519,13 @@ loadInputs inputs toline -- furthest line to read in input source files

1510 -- If it worked, load the whole thing from all the ibcs together

1519 -- If it worked, load the whole thing from all the ibcs together

1511 case errSpan inew of

1520 case errSpan inew of

1512 Nothing ->

1521 Nothing ->

1513− do putIState (ist { idris_tyinfodata = tidata })

1522+ do putIState $!! ist { idris_tyinfodata = tidata }

1514 ibcfiles <- mapM findNewIBC (nub (concat (map snd ifiles)))

1523 ibcfiles <- mapM findNewIBC (nub (concat (map snd ifiles)))

1515 tryLoad True (mapMaybe id ibcfiles)

1524 tryLoad True (mapMaybe id ibcfiles)

1516 _ -> return ()

1525 _ -> return ()

1517 ist <- getIState

1526 ist <- getIState

1518− putIState (ist { idris_tyinfodata = tidata,

1527+ putIState $! ist { idris_tyinfodata = tidata,

1519− idris_patdefs = patdefs })

1528+ idris_patdefs = patdefs }

1520 exports <- findExports

1529 exports <- findExports

1521

1530

1522 case opt getOutput opts of

1531 case opt getOutput opts of

@@ -1560,11 +1569,15 @@ loadInputs inputs toline -- furthest line to read in input source files

1560 let tidata = idris_tyinfodata inew

1569 let tidata = idris_tyinfodata inew

1561 let patdefs = idris_patdefs inew

1570 let patdefs = idris_patdefs inew

1562 ok <- noErrors

1571 ok <- noErrors

1572+ when ok $

1573+ -- The $!! here prevents a space leak on reloading.

1574+ -- This isn't a solution - but it's a temporary stopgap.

1575+ -- See issue #2386

1563− when ok $ do when (not keepstate) $ putIState ist

1576+ do when (not keepstate) $ putIState $!! ist

1564− ist <- getIState

1577+ ist <- getIState

1565− putIState (ist { idris_tyinfodata = tidata,

1578+ putIState $!! ist { idris_tyinfodata = tidata,

1566− idris_patdefs = patdefs })

1579+ idris_patdefs = patdefs }

1567− tryLoad keepstate fs

1580+ tryLoad keepstate fs

1568

1581

1569 ibc (IBC _ _) = True

1582 ibc (IBC _ _) = True

1570 ibc _ = False

1583 ibc _ = False