From 27f79255634d9789f367273504545c1ebfad90a0 Mon Sep 17 00:00:00 2001
From: Shea Levy <shea@shealevy.com>
Date: Tue, 20 Dec 2016 01:19:18 +0000
Subject: Allow use of the external interpreter in stage1.

Summary:
Now that we have -fexternal-interpreter, we can lose most of the GHCI ifdefs.

This was originally added in https://phabricator.haskell.org/D2826
but that led to a compatibility issue with ghc 7.10.x on Windows.
That's fixed here and the revert reverted.

Reviewers: goldfire, hvr, austin, bgamari, Phyx

Reviewed By: Phyx

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2884

GHC Trac Issues: #13008
---
 libraries/ghci/GHCi/Message.hs | 33 ++++++++++++++++++++++++++++++---
 1 file changed, 30 insertions(+), 3 deletions(-)

(limited to 'libraries/ghci/GHCi/Message.hs')

diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 4d0417e2da..fe4e95eb9e 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving,
-    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}
+{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,
+    GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards,
+    CPP #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
 
 -- |
@@ -14,6 +15,7 @@ module GHCi.Message
   , QResult(..)
   , EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)
   , SerializableException(..)
+  , toSerializableException, fromSerializableException
   , THResult(..), THResultType(..)
   , ResumeContext(..)
   , QState(..)
@@ -40,7 +42,11 @@ import Data.Dynamic
 import Data.IORef
 import Data.Map (Map)
 import GHC.Generics
+#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
+#endif
 import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import System.Exit
@@ -352,7 +358,28 @@ data SerializableException
   | EOtherException String
   deriving (Generic, Show)
 
-instance Binary ExitCode
+toSerializableException :: SomeException -> SerializableException
+toSerializableException ex
+  | Just UserInterrupt <- fromException ex  = EUserInterrupt
+  | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)
+  | otherwise = EOtherException (show (ex :: SomeException))
+
+fromSerializableException :: SerializableException -> SomeException
+fromSerializableException EUserInterrupt = toException UserInterrupt
+fromSerializableException (EExitCode c) = toException c
+fromSerializableException (EOtherException str) = toException (ErrorCall str)
+
+-- NB: Replace this with a derived instance once we depend on GHC 8.0
+-- as the minimum
+instance Binary ExitCode where
+  put ExitSuccess      = putWord8 0
+  put (ExitFailure ec) = putWord8 1 `mappend` put ec
+  get = do
+    w <- getWord8
+    case w of
+      0 -> pure ExitSuccess
+      _ -> ExitFailure <$> get
+
 instance Binary SerializableException
 
 data THResult a
-- 
cgit v1.2.1