module Hint.Eval (
      interpret, as, infer,
      unsafeInterpret,
      eval, runStmt,
      parens
) where

import qualified GHC.Exts (unsafeCoerce#)

import Control.Exception

import Data.Typeable (Typeable)
import qualified Data.Typeable as Typeable

import Hint.Base
import Hint.Context
import Hint.Parsers
import Hint.Util

import qualified Hint.GHC as GHC

-- | Convenience functions to be used with @interpret@ to provide witnesses.
--   Example:
--
--   * @interpret \"head [True,False]\" (as :: Bool)@
--
--   * @interpret \"head $ map show [True,False]\" infer >>= flip interpret (as :: Bool)@
as, infer :: Typeable a => a
as :: forall a. Typeable a => a
as    = a
forall a. HasCallStack => a
undefined
infer :: forall a. Typeable a => a
infer = a
forall a. HasCallStack => a
undefined

-- | Evaluates an expression, given a witness for its monomorphic type.
interpret :: (MonadInterpreter m, Typeable a) => String -> a -> m a
interpret :: forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
String -> a -> m a
interpret String
expr a
wit = String -> String -> m a
forall (m :: * -> *) a.
MonadInterpreter m =>
String -> String -> m a
unsafeInterpret String
expr (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ a -> TypeRep
forall a. Typeable a => a -> TypeRep
Typeable.typeOf a
wit)

unsafeInterpret :: (MonadInterpreter m) => String -> String -> m a
unsafeInterpret :: forall (m :: * -> *) a.
MonadInterpreter m =>
String -> String -> m a
unsafeInterpret String
expr String
type_str =
    do -- First, make sure the expression has no syntax errors,
       -- for this is the only way we have to "intercept" this
       -- kind of errors
       (String -> m ParseResult) -> String -> m ()
forall (m :: * -> *).
MonadInterpreter m =>
(String -> m ParseResult) -> String -> m ()
failOnParseError String -> m ParseResult
forall (m :: * -> *). MonadInterpreter m => String -> m ParseResult
parseExpr String
expr
       --
       let expr_typesig :: String
expr_typesig = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String -> String
parens String
expr, String
" :: ", String
type_str]
       HValue
expr_val <- m (Maybe HValue) -> m HValue
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe HValue) -> m HValue) -> m (Maybe HValue) -> m HValue
forall a b. (a -> b) -> a -> b
$ RunGhc m (Maybe HValue)
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc RunGhc m (Maybe HValue) -> RunGhc m (Maybe HValue)
forall a b. (a -> b) -> a -> b
$ String -> GhcT n (Maybe HValue)
forall (m :: * -> *). GhcMonad m => String -> m (Maybe HValue)
compileExpr String
expr_typesig
       --
       a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HValue -> a
GHC.Exts.unsafeCoerce# HValue
expr_val :: a)

-- add a bogus Maybe, in order to use it with mayFail
compileExpr :: GHC.GhcMonad m => String -> m (Maybe GHC.HValue)
compileExpr :: forall (m :: * -> *). GhcMonad m => String -> m (Maybe HValue)
compileExpr = (HValue -> Maybe HValue) -> m HValue -> m (Maybe HValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HValue -> Maybe HValue
forall a. a -> Maybe a
Just (m HValue -> m (Maybe HValue))
-> (String -> m HValue) -> String -> m (Maybe HValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m HValue
forall (m :: * -> *). GhcMonad m => String -> m HValue
GHC.compileExpr

-- | @eval expr@ will evaluate @show expr@.
--  It will succeed only if @expr@ has type t and there is a 'Show'
--  instance for t.
eval :: MonadInterpreter m => String -> m String
eval :: forall (m :: * -> *). MonadInterpreter m => String -> m String
eval String
expr = do String
in_scope_show   <- m String
forall (m :: * -> *). MonadInterpreter m => m String
supportShow
               String
in_scope_String <- m String
forall (m :: * -> *). MonadInterpreter m => m String
supportString
               let show_expr :: String
show_expr = [String] -> String
unwords [String
in_scope_show, String -> String
parens String
expr]
               String -> String -> m String
forall (m :: * -> *) a.
MonadInterpreter m =>
String -> String -> m a
unsafeInterpret String
show_expr String
in_scope_String

-- | Evaluate a statement in the 'IO' monad, possibly binding new names.
--
-- Example:
--
-- > runStmt "x <- return 42"
-- > runStmt "print x"
runStmt :: (MonadInterpreter m) => String -> m ()
runStmt :: forall (m :: * -> *). MonadInterpreter m => String -> m ()
runStmt String
s = m (Maybe ()) -> m ()
forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
mayFail (m (Maybe ()) -> m ()) -> m (Maybe ()) -> m ()
forall a b. (a -> b) -> a -> b
$ RunGhc m (Maybe ())
forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
runGhc RunGhc m (Maybe ()) -> RunGhc m (Maybe ())
forall a b. (a -> b) -> a -> b
$ String -> GhcT n (Maybe ())
forall {m :: * -> *}. GhcMonad m => String -> m (Maybe ())
go String
s
    where
    go :: String -> m (Maybe ())
go String
statements = do
        ExecResult
result <- String -> ExecOptions -> m ExecResult
forall (m :: * -> *).
GhcMonad m =>
String -> ExecOptions -> m ExecResult
GHC.execStmt String
statements ExecOptions
GHC.execOptions
        Maybe () -> m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> m (Maybe ())) -> Maybe () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ case ExecResult
result of
            GHC.ExecComplete { execResult :: ExecResult -> Either SomeException [Name]
GHC.execResult = Right [Name]
_ } -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
            GHC.ExecComplete { execResult :: ExecResult -> Either SomeException [Name]
GHC.execResult = Left  SomeException
e } -> SomeException -> Maybe ()
forall a e. Exception e => e -> a
throw SomeException
e
            ExecResult
_                                             -> Maybe ()
forall a. Maybe a
Nothing

-- | Conceptually, @parens s = \"(\" ++ s ++ \")\"@, where s is any valid haskell
-- expression. In practice, it is harder than this.
-- Observe that if @s@ ends with a trailing comment, then @parens s@ would
-- be a malformed expression. The straightforward solution for this is to
-- put the closing parenthesis in a different line. However, now we are
-- messing with the layout rules and we don't know where @s@ is going to
-- be used!
-- Solution: @parens s = \"(let {foo =\\n\" ++ s ++ \"\\n ;} in foo)\"@ where @foo@ does not occur in @s@
parens :: String -> String
parens :: String -> String
parens String
s = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(let {", String
foo, String
" =\n", String
s, String
"\n",
                   String
"                     ;} in ", String
foo, String
")"]
    where foo :: String
foo = String -> String
safeBndFor String
s