{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
module Language.Haskell.Liquid.Synthesize.GHC where

import qualified CoreSyn                       as GHC
import qualified Language.Fixpoint.Types       as F
import           Language.Haskell.Liquid.Types
import           Var
import           TyCoRep
import           CoreSyn
import           IdInfo
import           OccName
import           Unique
import           Name
import           TysPrim
import           Data.Default
import           Data.Maybe                     ( fromMaybe )
import           Language.Haskell.Liquid.GHC.TypeRep
import           Language.Fixpoint.Types
import qualified Data.HashMap.Strict           as M
import           TyCon
import           TysWiredIn

import           Data.List
import           Data.List.Split

instance Default Type where
    def :: Type
def = Var -> Type
TyVarTy Var
alphaTyVar 

mkVar :: Maybe String -> Int -> Type -> Var
mkVar :: Maybe String -> Int -> Type -> Var
mkVar Maybe String
x Int
i Type
t = IdDetails -> Name -> Type -> IdInfo -> Var
mkGlobalVar IdDetails
VanillaId Name
name Type
t IdInfo
vanillaIdInfo 
  where 
    name :: Name
name = Unique -> OccName -> Name
mkSystemName (Char -> Int -> Unique
mkUnique Char
'S' Int
i) (String -> OccName
mkVarOcc String
x')
    x' :: String
x'   = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (Int -> String
freshName Int
i) Maybe String
x 

freshName :: Int -> String 
freshName :: Int -> String
freshName Int
i = String
"lSyn$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i 

-- | Assuming that the functions are instantiated when this function is called.
goalType ::  Type ->   --  This is the goal type. It is used for basic types.
              Type ->  --   This type comes from the environment.
              Bool     --   True if the 2nd arg produces expression 
                       --   of type equal to 1st argument.
#if __GLASGOW_HASKELL__ >= 810
goalType :: Type -> Type -> Bool
goalType Type
τ (FunTy AnonArgFlag
_ Type
_ Type
t'') 
  | Type
t'' Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
τ  = Bool
True
  | Bool
otherwise = Type -> Type -> Bool
goalType Type
τ Type
t''
#else
goalType τ (FunTy _ t'') 
  | t'' == τ  = True
  | otherwise = goalType τ t''
#endif
goalType Type
τ                 Type
t 
  | Type
τ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t    = Bool
True
  | Bool
otherwise = Bool
False

-- Subgoals are function's arguments.
createSubgoals :: Type -> [Type] 
createSubgoals :: Type -> [Type]
createSubgoals (ForAllTy TyCoVarBinder
_ Type
htype) = Type -> [Type]
createSubgoals Type
htype
#if __GLASGOW_HASKELL__ >= 810
createSubgoals (FunTy AnonArgFlag
_ Type
t1 Type
t2)      = Type
t1 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
createSubgoals Type
t2
#else
createSubgoals (FunTy t1 t2)      = t1 : createSubgoals t2
#endif
createSubgoals Type
t                  = [Type
t]

subgoals :: Type ->               -- Given a function type,
            Maybe (Type, [Type])  -- separate the result type from the input types.
subgoals :: Type -> Maybe (Type, [Type])
subgoals Type
t = if [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
gTys then Maybe (Type, [Type])
forall a. Maybe a
Nothing else (Type, [Type]) -> Maybe (Type, [Type])
forall a. a -> Maybe a
Just (Type
resTy, [Type]
inpTys) 
  where gTys :: [Type]
gTys            = Type -> [Type]
createSubgoals Type
t 
        (Type
resTy, [Type]
inpTys) = ([Type] -> Type
forall a. [a] -> a
last [Type]
gTys, Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
take ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
gTys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Type]
gTys)


-- @withSubgoal@ :: Takes a subgoal type, and 
-- returns all expressions in @ExprMemory@ that have the same type.
withSubgoal :: [(Type, CoreExpr, Int)] -> Type -> [(CoreExpr, Int)]
withSubgoal :: [(Type, CoreExpr, Int)] -> Type -> [(CoreExpr, Int)]
withSubgoal []                  Type
_ = []
withSubgoal ((Type
t, CoreExpr
e, Int
i) : [(Type, CoreExpr, Int)]
exprs) Type
τ = 
  if Type
τ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t 
    then (CoreExpr
e, Int
i) (CoreExpr, Int) -> [(CoreExpr, Int)] -> [(CoreExpr, Int)]
forall a. a -> [a] -> [a]
: [(Type, CoreExpr, Int)] -> Type -> [(CoreExpr, Int)]
withSubgoal [(Type, CoreExpr, Int)]
exprs Type
τ
    else [(Type, CoreExpr, Int)] -> Type -> [(CoreExpr, Int)]
withSubgoal [(Type, CoreExpr, Int)]
exprs Type
τ

-- | Assuming that goals are type variables or constructors.
--    Note: We maintain ordering from the goal type.
--    Not handled (compared to @varsInType): function types, type applications
unifyWith :: Type -> [Type] 
unifyWith :: Type -> [Type]
unifyWith v :: Type
v@(TyVarTy Var
_)   = [Type
v] 
unifyWith (TyConApp TyCon
_ [Type]
ts) = [Type]
ts 
unifyWith Type
t               = String -> [Type]
forall a. HasCallStack => String -> a
error (String -> [Type]) -> String -> [Type]
forall a b. (a -> b) -> a -> b
$ String
" [ unifyWith ] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
showTy Type
t 

fromAnf :: CoreExpr -> CoreExpr
fromAnf :: CoreExpr -> CoreExpr
fromAnf CoreExpr
e = (CoreExpr, [(Var, CoreExpr)]) -> CoreExpr
forall a b. (a, b) -> a
fst ((CoreExpr, [(Var, CoreExpr)]) -> CoreExpr)
-> (CoreExpr, [(Var, CoreExpr)]) -> CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e []

-- | Replace let bindings in applications.
--   > If you find a binding add it to the second argument.
--                    | (lhs, rhs)      |
fromAnf' :: CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' :: CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' (Lam Var
b CoreExpr
e) [(Var, CoreExpr)]
bnds
  = let (CoreExpr
e', [(Var, CoreExpr)]
bnds') = CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e [(Var, CoreExpr)]
bnds
    in  (Var -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Var
b CoreExpr
e', [(Var, CoreExpr)]
bnds')
fromAnf' (Let Bind Var
bnd CoreExpr
e) [(Var, CoreExpr)]
bnds
  = case Bind Var
bnd of Rec {}       -> String -> (CoreExpr, [(Var, CoreExpr)])
forall a. HasCallStack => String -> a
error String
" By construction, no recursive bindings in let expression. "
                NonRec Var
rb CoreExpr
lb -> let (CoreExpr
lb', [(Var, CoreExpr)]
bnds') = CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
lb [(Var, CoreExpr)]
bnds
                                in  CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e ((Var
rb, CoreExpr
lb') (Var, CoreExpr) -> [(Var, CoreExpr)] -> [(Var, CoreExpr)]
forall a. a -> [a] -> [a]
: [(Var, CoreExpr)]
bnds')
fromAnf' (Var Var
var) [(Var, CoreExpr)]
bnds 
  = (CoreExpr -> Maybe CoreExpr -> CoreExpr
forall a. a -> Maybe a -> a
fromMaybe (Var -> CoreExpr
forall b. Var -> Expr b
Var Var
var) (Var -> [(Var, CoreExpr)] -> Maybe CoreExpr
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Var
var [(Var, CoreExpr)]
bnds), [(Var, CoreExpr)]
bnds)
fromAnf' (Case CoreExpr
scr Var
bnd Type
tp [Alt Var]
alts) [(Var, CoreExpr)]
bnds
  = (CoreExpr -> Var -> Type -> [Alt Var] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case CoreExpr
scr Var
bnd Type
tp ((Alt Var -> Alt Var) -> [Alt Var] -> [Alt Var]
forall a b. (a -> b) -> [a] -> [b]
map (\(AltCon
altc, [Var]
xs, CoreExpr
e) -> (AltCon
altc, [Var]
xs, (CoreExpr, [(Var, CoreExpr)]) -> CoreExpr
forall a b. (a, b) -> a
fst ((CoreExpr, [(Var, CoreExpr)]) -> CoreExpr)
-> (CoreExpr, [(Var, CoreExpr)]) -> CoreExpr
forall a b. (a -> b) -> a -> b
$ CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e [(Var, CoreExpr)]
bnds)) [Alt Var]
alts), [(Var, CoreExpr)]
bnds)
fromAnf' (App CoreExpr
e1 CoreExpr
e2) [(Var, CoreExpr)]
bnds
  = let (CoreExpr
e1', [(Var, CoreExpr)]
bnds')  = CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e1 [(Var, CoreExpr)]
bnds 
        (CoreExpr
e2', [(Var, CoreExpr)]
bnds'') = CoreExpr -> [(Var, CoreExpr)] -> (CoreExpr, [(Var, CoreExpr)])
fromAnf' CoreExpr
e2 [(Var, CoreExpr)]
bnds'
    in  (CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App CoreExpr
e1' CoreExpr
e2', [(Var, CoreExpr)]
bnds'')
fromAnf' t :: CoreExpr
t@Type{} [(Var, CoreExpr)]
bnds 
  = (CoreExpr
t, [(Var, CoreExpr)]
bnds)
fromAnf' l :: CoreExpr
l@Lit{} [(Var, CoreExpr)]
bnds 
  = (CoreExpr
l, [(Var, CoreExpr)]
bnds)
fromAnf' CoreExpr
_ [(Var, CoreExpr)]
_
  = String -> (CoreExpr, [(Var, CoreExpr)])
forall a. HasCallStack => String -> a
error String
" Should not reach this point. "

-- | Function used for pretty printing core as Haskell source.
--   Input does not contain let bindings.
coreToHs :: SpecType -> Var -> CoreExpr -> String
coreToHs :: SpecType -> Var -> CoreExpr -> String
coreToHs SpecType
t Var
v CoreExpr
e = String -> String
pprintSymbols (Var -> String
discardModName Var
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
caseIndent Var
v CoreExpr
e (String -> Int -> Int
forall a. PPrint a => String -> a -> a
tracepp String
" cnt " Int
cnt) [])
  where cnt :: Int
cnt = SpecType -> Int
countTcConstraints SpecType
t

symbols :: String
symbols :: String
symbols = [Char
':']

pprintSymbols :: String -> String
pprintSymbols :: String -> String
pprintSymbols String
txt = (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
x String
xs -> String -> Char -> String
pprintSym String
symbols Char
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xs) [] String
txt

pprintSym :: String -> Char -> String
pprintSym :: String -> Char -> String
pprintSym String
symbols Char
s 
  = case (Char -> Bool) -> String -> Maybe Char
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
s) String
symbols of 
      Maybe Char
Nothing -> [Char
s]
      Just Char
s' -> [Char
'(', Char
s', Char
')']

discardModName :: Var -> String
discardModName :: Var -> String
discardModName Var
v = [String] -> String
forall a. [a] -> a
last (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." (Var -> String
forall a. Show a => a -> String
show Var
v))

rmModName :: String -> String
rmModName :: String -> String
rmModName String
s = 
  let ts :: [String]
ts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s
  in  [String] -> String
maintainLParen [String]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. [a] -> a
last [String]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
maintainRParen [String]
ts

maintainLParen :: [String] -> String
maintainLParen :: [String] -> String
maintainLParen [String]
ts 
  = if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
head ([String] -> String
forall a. [a] -> a
head [String]
ts) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
      then  String
"("
      else  String
""

maintainRParen :: [String] -> String
maintainRParen :: [String] -> String
maintainRParen [String]
ts 
  = if String -> Char
forall a. [a] -> a
last ([String] -> String
forall a. [a] -> a
last [String]
ts) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
      then  String
")"
      else  String
""

pprintFormals :: Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals :: Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
i Var
v (Lam Var
b CoreExpr
e) Int
cnt [Var]
vs
  = if Var -> Bool
isTyVar Var
b
      then Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
i Var
v CoreExpr
e Int
cnt [Var]
vs
      else  if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 
              then  Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
i Var
v CoreExpr
e (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Var
bVar -> [Var] -> [Var]
forall a. a -> [a] -> [a]
:[Var]
vs)
              else  String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
i Var
v CoreExpr
e Int
cnt [Var]
vs
pprintFormals Int
i Var
_ CoreExpr
e Int
_ [Var]
vs
  = String
" =" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Var] -> Int -> CoreExpr -> String
pprintBody [Var]
vs Int
i CoreExpr
e

caseIndent :: Int 
caseIndent :: Int
caseIndent = Int
4

indent :: Int -> String
indent :: Int -> String
indent Int
i = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i Char
' '

errorExprPp :: CoreExpr -> Bool
errorExprPp :: CoreExpr -> Bool
errorExprPp (GHC.App (GHC.App err :: CoreExpr
err@(GHC.Var Var
_) (GHC.Type Type
_)) CoreExpr
_)
  = CoreExpr -> String
forall a. Show a => a -> String
show CoreExpr
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Language.Haskell.Liquid.Synthesize.Error.err"
errorExprPp CoreExpr
_ 
  = Bool
False

pprintVar :: Var -> String 
pprintVar :: Var -> String
pprintVar Var
v = if Var -> Bool
isTyVar Var
v then String
"" else String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Var -> String
discardModName Var
v

pprintBody :: [Var] -> Int -> CoreExpr -> String
pprintBody :: [Var] -> Int -> CoreExpr -> String
pprintBody [Var]
vs Int
i (Lam Var
b CoreExpr
e) 
  = Int -> Var -> CoreExpr -> Int -> [Var] -> String
pprintFormals Int
i Var
b CoreExpr
e Int
0 [Var]
vs
pprintBody [Var]
vs Int
_ (Var Var
v)
  = case (Var -> Bool) -> [Var] -> Maybe Var
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v) [Var]
vs of 
      Maybe Var
Nothing -> Var -> String
pprintVar Var
v
      Just Var
_  -> String
""
pprintBody [Var]
vs Int
_ e :: CoreExpr
e@App{}
  = let pprintApp :: String
pprintApp = String -> String
fixApplication (CoreExpr -> String
forall a. Show a => a -> String
show CoreExpr
e)
        noTcVars :: [String]
noTcVars  = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
x -> case (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x) ((Var -> String) -> [Var] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Var -> String
forall a. Show a => a -> String
show [Var]
vs) of 
                                    Maybe String
Nothing -> Bool
True
                                    Just String
_  -> Bool
False) (String -> [String]
words String
pprintApp)
    in  if CoreExpr -> Bool
errorExprPp CoreExpr
e
          then String
" error \" Dead code! \" "
          else String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
noTcVars
pprintBody [Var]
_ Int
_ l :: CoreExpr
l@Lit{}
  = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CoreExpr -> String
forall a. Show a => a -> String
show CoreExpr
l
pprintBody [Var]
vs Int
i (Case CoreExpr
scr Var
_ Type
_ [Alt Var]
alts)
  = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
    String
"case" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Var] -> Int -> CoreExpr -> String
pprintBody [Var]
vs Int
i CoreExpr
scr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
    (Alt Var -> String) -> [Alt Var] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Var] -> Int -> Alt Var -> String
pprintAlts [Var]
vs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
caseIndent)) [Alt Var]
alts 
pprintBody [Var]
_ Int
_ Type{} 
  = String
""
pprintBody [Var]
_ Int
_ CoreExpr
e
  = String -> String
forall a. HasCallStack => String -> a
error (String
" Not yet implemented for e = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CoreExpr -> String
forall a. Show a => a -> String
show CoreExpr
e)

fixApplication :: String -> String
fixApplication :: String -> String
fixApplication String
e = 
  let ws' :: [String]
ws' = String -> [String]
words (String -> String
replaceNewLine String
e)
      ws :: [String]
ws = [String] -> [String]
handleCommas [String]
ws'
      cleanWs :: [String]
cleanWs = [String] -> [String]
rmTypeAppl [String]
ws
  in  [String] -> String
unwords ([String] -> [String]
fixCommas ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
fixParen ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
rmModName [String]
cleanWs))

handleCommas :: [String] -> [String]
handleCommas :: [String] -> [String]
handleCommas [] = []
handleCommas (String
c:[String]
cs)
  = if String -> Char
forall a. [a] -> a
last String
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','
      then String -> String
forall a. [a] -> [a]
init String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"," String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
handleCommas [String]
cs
      else String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
handleCommas [String]
cs

fixCommas :: [String] -> [String]
fixCommas :: [String] -> [String]
fixCommas [] = []
fixCommas [String
x] = [String
x]
fixCommas (String
x:String
y:[String]
xs)
  = if String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
","
      then (String
xString -> String -> String
forall a. [a] -> [a] -> [a]
++String
y) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
fixCommas [String]
xs
      else String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
fixCommas (String
yString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)

fixParen :: [String] -> [String]
fixParen :: [String] -> [String]
fixParen [] = []
fixParen [String
x] = [String
x]
fixParen (String
x:String
y:[String]
xs) 
  = if Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y) Char
')' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
      then  let w0 :: String
w0 = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y 
                w :: String
w = if String -> Char
forall a. [a] -> a
head String
w0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
w0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' 
                      then String -> String
forall a. [a] -> [a]
tail (String -> String
forall a. [a] -> [a]
init String
w0) 
                      else String
w0
            in  String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
fixParen [String]
xs
      else String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
fixParen (String
yString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)

rmTypeAppl :: [String] -> [String]
rmTypeAppl :: [String] -> [String]
rmTypeAppl [] 
  = []
rmTypeAppl (String
c:[String]
cs) 
  = if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"@"
      then  case [String]
cs of 
              [] -> String -> [String]
forall a. HasCallStack => String -> a
error String
" Type application: Badly formatted string. "
              (String
c': [String]
cs') -> 
                let p :: String
p = String -> String
paren String
c'
                in  if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p then [String] -> [String]
rmTypeAppl [String]
cs' else String
p String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
rmTypeAppl [String]
cs'
      else String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String] -> [String]
rmTypeAppl [String]
cs

paren :: String -> String 
paren :: String -> String
paren [] 
  = []
paren (Char
c:String
cs) 
  = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' then Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
paren String
cs else String -> String
paren String
cs

replaceNewLine :: String -> String
replaceNewLine :: String -> String
replaceNewLine [] 
  = []
replaceNewLine (Char
c:String
cs) 
  = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' 
      then Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
replaceNewLine String
cs 
      else Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
replaceNewLine String
cs

pprintAlts :: [Var] -> Int -> Alt Var -> String
pprintAlts :: [Var] -> Int -> Alt Var -> String
pprintAlts [Var]
vars Int
i (DataAlt DataCon
dataCon, [Var]
vs, CoreExpr
e)
  = Int -> String
indent Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ DataCon -> String
forall a. Show a => a -> String
show DataCon
dataCon String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Var -> String) -> [Var] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Var
v -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
v) [Var]
vs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
    [Var] -> Int -> CoreExpr -> String
pprintBody [Var]
vars (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
caseIndent) CoreExpr
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
pprintAlts [Var]
_ Int
_ Alt Var
_
  = String -> String
forall a. HasCallStack => String -> a
error String
" Pretty printing for pattern match on datatypes. "

-- TODO Remove variables generated for type class constraints
countTcConstraints :: SpecType -> Int
countTcConstraints :: SpecType -> Int
countTcConstraints SpecType
t = 
  let ws :: [String]
ws = String -> [String]
words (SpecType -> String
forall a. Show a => a -> String
show SpecType
t)

      countCommas :: [String] -> Int
      countCommas :: [String] -> Int
countCommas []     = Int
0
      countCommas (String
x:[String]
xs) = 
        case (Char -> Bool) -> String -> Maybe Char
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
x of
          Maybe Char
Nothing -> [String] -> Int
countCommas [String]
xs
          Just Char
_  -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
countCommas [String]
xs

  in  case (String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"=>") [String]
ws of
        Maybe String
Nothing -> Int
0
        Just String
_  -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [String] -> Int
countCommas ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"=>") [String]
ws)
  


-----------------------------------------------------------------------------------
--  |                          Prune trivial expressions                       | --
-----------------------------------------------------------------------------------
nonTrivial :: GHC.CoreExpr -> Bool
nonTrivial :: CoreExpr -> Bool
nonTrivial (GHC.App CoreExpr
_ (GHC.Type Type
_)) = Bool
False
nonTrivial CoreExpr
_                        = Bool
True

nonTrivials :: [GHC.CoreExpr] -> Bool
nonTrivials :: [CoreExpr] -> Bool
nonTrivials = (CoreExpr -> Bool -> Bool) -> Bool -> [CoreExpr] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\CoreExpr
x Bool
b -> CoreExpr -> Bool
nonTrivial CoreExpr
x Bool -> Bool -> Bool
|| Bool
b) Bool
False 

trivial :: GHC.CoreExpr -> Bool
trivial :: CoreExpr -> Bool
trivial (GHC.App (GHC.Var Var
_) (GHC.Type Type
_)) = Bool
True -- Is this a nullary constructor?
trivial CoreExpr
_ = Bool
False

hasTrivial :: [GHC.CoreExpr] -> Bool
hasTrivial :: [CoreExpr] -> Bool
hasTrivial [CoreExpr]
es = (CoreExpr -> Bool -> Bool) -> Bool -> [CoreExpr] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\CoreExpr
x Bool
b -> CoreExpr -> Bool
trivial CoreExpr
x Bool -> Bool -> Bool
|| Bool
b) Bool
False [CoreExpr]
es

allTrivial :: [[GHC.CoreExpr]] -> Bool
allTrivial :: [[CoreExpr]] -> Bool
allTrivial [[CoreExpr]]
es = ([CoreExpr] -> Bool -> Bool) -> Bool -> [[CoreExpr]] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[CoreExpr]
x Bool
b -> [CoreExpr] -> Bool
hasTrivial [CoreExpr]
x Bool -> Bool -> Bool
&& Bool
b) Bool
True [[CoreExpr]]
es 

rmTrivials :: [(GHC.CoreExpr, Int)] -> [(GHC.CoreExpr, Int)]
rmTrivials :: [(CoreExpr, Int)] -> [(CoreExpr, Int)]
rmTrivials = ((CoreExpr, Int) -> Bool) -> [(CoreExpr, Int)] -> [(CoreExpr, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((CoreExpr, Int) -> Bool) -> (CoreExpr, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> Bool
trivial (CoreExpr -> Bool)
-> ((CoreExpr, Int) -> CoreExpr) -> (CoreExpr, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CoreExpr, Int) -> CoreExpr
forall a b. (a, b) -> a
fst)

----------------------------------------------------------------------------------
--  |                        Scrutinee filtering                              | --
----------------------------------------------------------------------------------

isVar :: GHC.CoreExpr -> Bool
isVar :: CoreExpr -> Bool
isVar (GHC.Var Var
_) = Bool
True
isVar CoreExpr
_           = Bool
False

returnsTuple :: Var -> Bool
returnsTuple :: Var -> Bool
returnsTuple Var
v = 
  case Type -> Maybe (Type, [Type])
subgoals (Var -> Type
varType Var
v) of
    Maybe (Type, [Type])
Nothing      -> Bool
False
    Just (Type
t, [Type]
_) -> 
      case Type
t of
        TyConApp TyCon
c [Type]
_ts -> TyCon
c TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
pairTyCon
        Type
_              -> Bool
False

------------------------------------------------------------------------------------------------
-------------------------------------- Handle REnv ---------------------------------------------
------------------------------------------------------------------------------------------------
-- Duplicate from Monad due to dependencies between modules.
type SSEnv = M.HashMap Symbol (SpecType, Var)

filterREnv :: M.HashMap Symbol SpecType -> M.HashMap Symbol SpecType
filterREnv :: HashMap Symbol SpecType -> HashMap Symbol SpecType
filterREnv HashMap Symbol SpecType
renv = 
  let renv_lst :: [(Symbol, SpecType)]
renv_lst  = HashMap Symbol SpecType -> [(Symbol, SpecType)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Symbol SpecType
renv
      renv_lst' :: [(Symbol, SpecType)]
renv_lst' = ((Symbol, SpecType) -> Bool)
-> [(Symbol, SpecType)] -> [(Symbol, SpecType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Symbol
_, SpecType
specT) ->  let ht :: Type
ht = SpecType -> Type
forall r. ToTypeable r => RRType r -> Type
toType SpecType
specT
                                          in  Type -> String
showTy Type
ht String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"(RApp   GHC.Prim.Addr# )") [(Symbol, SpecType)]
renv_lst
  in  [(Symbol, SpecType)] -> HashMap Symbol SpecType
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Symbol, SpecType)]
renv_lst'

getTopLvlBndrs :: GHC.CoreProgram -> [Var]
getTopLvlBndrs :: CoreProgram -> [Var]
getTopLvlBndrs = (Bind Var -> [Var]) -> CoreProgram -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case GHC.NonRec Var
b CoreExpr
_ -> [Var
b]
                                  GHC.Rec [(Var, CoreExpr)]
recs   -> ((Var, CoreExpr) -> Var) -> [(Var, CoreExpr)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst [(Var, CoreExpr)]
recs)

-- | That' s a hack to get the type variables we need for instantiation.
getUniVars :: GHC.CoreProgram -> Var -> ([Var], [Var])
getUniVars :: CoreProgram -> Var -> ([Var], [Var])
getUniVars CoreProgram
cp Var
tlVar = 
  case (Bind Var -> Bool) -> CoreProgram -> CoreProgram
forall a. (a -> Bool) -> [a] -> [a]
filter (Bind Var -> Var -> Bool
`isInCB` Var
tlVar) CoreProgram
cp of 
    [Bind Var
cb] -> CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 (Bind Var -> Var -> CoreExpr
getBody Bind Var
cb Var
tlVar) ([], [])
    CoreProgram
_    -> String -> ([Var], [Var])
forall a. HasCallStack => String -> a
error String
" Every top-level corebind must be unique! "

getUniVars0 :: GHC.CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 :: CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 (Lam Var
b CoreExpr
e) ([Var]
uvs, [Var]
tcDicts)
  = case Var -> Type
varType Var
b of 
      TyConApp TyCon
c [Type]
_ -> 
        if TyCon -> Bool
isClassTyCon TyCon
c 
          then CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 CoreExpr
e ([Var]
uvs, Var
b Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: [Var]
tcDicts)
          else CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 CoreExpr
e (Var
bVar -> [Var] -> [Var]
forall a. a -> [a] -> [a]
:[Var]
uvs, [Var]
tcDicts)
      Type
_ -> CoreExpr -> ([Var], [Var]) -> ([Var], [Var])
getUniVars0 CoreExpr
e (Var
bVar -> [Var] -> [Var]
forall a. a -> [a] -> [a]
:[Var]
uvs, [Var]
tcDicts) 
getUniVars0 CoreExpr
_ ([Var], [Var])
vs
  = ([Var], [Var])
vs

getBody :: GHC.CoreBind -> Var -> GHC.CoreExpr
getBody :: Bind Var -> Var -> CoreExpr
getBody (GHC.NonRec Var
b CoreExpr
e) Var
tlVar = if Var
b Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
tlVar then CoreExpr
e else String -> CoreExpr
forall a. HasCallStack => String -> a
error String
" [ getBody ] "
getBody (GHC.Rec [(Var, CoreExpr)]
_)   Var
_ = String -> CoreExpr
forall a. HasCallStack => String -> a
error String
"Assuming our top-level binder is non-recursive (only contains a hole)"

--                       | Current top-level binder |
varsP :: GHC.CoreProgram -> Var -> (GHC.CoreExpr -> [Var]) -> [Var]
varsP :: CoreProgram -> Var -> (CoreExpr -> [Var]) -> [Var]
varsP CoreProgram
cp Var
tlVar CoreExpr -> [Var]
f = 
  case (Bind Var -> Bool) -> CoreProgram -> CoreProgram
forall a. (a -> Bool) -> [a] -> [a]
filter (\Bind Var
cb -> Bind Var -> Var -> Bool
isInCB Bind Var
cb Var
tlVar) CoreProgram
cp of
    [Bind Var
cb] -> Bind Var -> (CoreExpr -> [Var]) -> [Var]
varsCB Bind Var
cb CoreExpr -> [Var]
f
    CoreProgram
_    -> String -> [Var]
forall a. HasCallStack => String -> a
error String
" Every top-level corebind must be unique! "

isInCB :: GHC.CoreBind -> Var -> Bool
isInCB :: Bind Var -> Var -> Bool
isInCB (GHC.NonRec Var
b CoreExpr
_) Var
tlVar = Var
b Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
tlVar 
isInCB (GHC.Rec [(Var, CoreExpr)]
recs) Var
tlVar   = ((Var, CoreExpr) -> Bool -> Bool)
-> Bool -> [(Var, CoreExpr)] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((\Var
v Bool
b -> Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
tlVar Bool -> Bool -> Bool
&& Bool
b) (Var -> Bool -> Bool)
-> ((Var, CoreExpr) -> Var) -> (Var, CoreExpr) -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, CoreExpr) -> Var
forall a b. (a, b) -> a
fst) Bool
True [(Var, CoreExpr)]
recs

varsCB :: GHC.CoreBind -> (GHC.CoreExpr -> [Var]) -> [Var]
varsCB :: Bind Var -> (CoreExpr -> [Var]) -> [Var]
varsCB (GHC.NonRec Var
_ CoreExpr
e) CoreExpr -> [Var]
f = CoreExpr -> [Var]
f CoreExpr
e
varsCB (GHC.Rec [(Var, CoreExpr)]
_) CoreExpr -> [Var]
_ = String -> [Var] -> [Var]
forall a. String -> a -> a
notrace String
" [ symbolToVarCB ] Rec " []

varsE :: GHC.CoreExpr -> [Var]
varsE :: CoreExpr -> [Var]
varsE (GHC.Lam Var
a CoreExpr
e) = Var
a Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: CoreExpr -> [Var]
varsE CoreExpr
e
varsE (GHC.Let (GHC.NonRec Var
b CoreExpr
_) CoreExpr
e) = Var
b Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: CoreExpr -> [Var]
varsE CoreExpr
e
varsE (GHC.Case CoreExpr
_ Var
b Type
_ [Alt Var]
alts) = (Alt Var -> [Var] -> [Var]) -> [Var] -> [Alt Var] -> [Var]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(AltCon
_, [Var]
vars, CoreExpr
e) [Var]
res -> [Var]
vars [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ CoreExpr -> [Var]
varsE CoreExpr
e [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
res) [Var
b] [Alt Var]
alts
varsE (GHC.Tick Tickish Var
_ CoreExpr
e) = CoreExpr -> [Var]
varsE CoreExpr
e
varsE CoreExpr
_ = []

caseVarsE :: GHC.CoreExpr -> [Var] 
caseVarsE :: CoreExpr -> [Var]
caseVarsE (GHC.Lam Var
_ CoreExpr
e) = CoreExpr -> [Var]
caseVarsE CoreExpr
e 
caseVarsE (GHC.Let (GHC.NonRec Var
_ CoreExpr
_) CoreExpr
e) = CoreExpr -> [Var]
caseVarsE CoreExpr
e
caseVarsE (GHC.Case CoreExpr
_ Var
b Type
_ [Alt Var]
alts) = (Alt Var -> [Var] -> [Var]) -> [Var] -> [Alt Var] -> [Var]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(AltCon
_, [Var]
_, CoreExpr
e) [Var]
res -> CoreExpr -> [Var]
caseVarsE CoreExpr
e [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
res) [Var
b] [Alt Var]
alts 
caseVarsE (GHC.Tick Tickish Var
_ CoreExpr
e) = CoreExpr -> [Var]
caseVarsE CoreExpr
e 
caseVarsE CoreExpr
_ = [] 

instance Default Var where
  def :: Var
def = Var
alphaTyVar

symbolToVar :: GHC.CoreProgram -> Var -> M.HashMap Symbol SpecType -> SSEnv
symbolToVar :: CoreProgram -> Var -> HashMap Symbol SpecType -> SSEnv
symbolToVar CoreProgram
cp Var
tlBndr HashMap Symbol SpecType
renv = 
  let vars :: [(Symbol, Var)]
vars = [(Var -> Symbol
forall a. Symbolic a => a -> Symbol
F.symbol Var
x, Var
x) | Var
x <- CoreProgram -> Var -> (CoreExpr -> [Var]) -> [Var]
varsP CoreProgram
cp Var
tlBndr CoreExpr -> [Var]
varsE]
      casevars :: [Symbol]
casevars = [Var -> Symbol
forall a. Symbolic a => a -> Symbol
F.symbol Var
x | Var
x <- CoreProgram -> Var -> (CoreExpr -> [Var]) -> [Var]
varsP CoreProgram
cp Var
tlBndr CoreExpr -> [Var]
caseVarsE]
      tlVars :: [(Symbol, Var)]
tlVars = [(Var -> Symbol
forall a. Symbolic a => a -> Symbol
F.symbol Var
x, Var
x) | Var
x <- CoreProgram -> [Var]
getTopLvlBndrs CoreProgram
cp]
      lookupErrorMsg :: a -> String
lookupErrorMsg a
x = String
" [ symbolToVar ] impossible lookup for x = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
      symbolVar :: Symbol -> Var
symbolVar Symbol
x = Var -> Maybe Var -> Var
forall a. a -> Maybe a -> a
fromMaybe (Var -> Maybe Var -> Var
forall a. a -> Maybe a -> a
fromMaybe (String -> Var
forall a. HasCallStack => String -> a
error (Symbol -> String
forall a. Show a => a -> String
lookupErrorMsg Symbol
x)) (Maybe Var -> Var) -> Maybe Var -> Var
forall a b. (a -> b) -> a -> b
$ Symbol -> [(Symbol, Var)] -> Maybe Var
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Symbol
x [(Symbol, Var)]
tlVars) (Maybe Var -> Var) -> Maybe Var -> Var
forall a b. (a -> b) -> a -> b
$ Symbol -> [(Symbol, Var)] -> Maybe Var
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Symbol
x [(Symbol, Var)]
vars
      renv' :: HashMap Symbol SpecType
renv' = (Symbol -> HashMap Symbol SpecType -> HashMap Symbol SpecType)
-> HashMap Symbol SpecType -> [Symbol] -> HashMap Symbol SpecType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Symbol -> HashMap Symbol SpecType -> HashMap Symbol SpecType
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete HashMap Symbol SpecType
renv [Symbol]
casevars
  in  [(Symbol, (SpecType, Var))] -> SSEnv
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [ (Symbol
s, (SpecType
t, Symbol -> Var
symbolVar Symbol
s)) | (Symbol
s, SpecType
t) <- HashMap Symbol SpecType -> [(Symbol, SpecType)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Symbol SpecType
renv']

argsP :: GHC.CoreProgram -> Var -> [Var] 
argsP :: CoreProgram -> Var -> [Var]
argsP []         Var
tlVar = String -> [Var]
forall a. HasCallStack => String -> a
error (String -> [Var]) -> String -> [Var]
forall a b. (a -> b) -> a -> b
$ String
" [ argsP ] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
tlVar
argsP (Bind Var
cb : CoreProgram
cbs) Var
tlVar 
  | Bind Var -> Var -> Bool
isInCB Bind Var
cb Var
tlVar = Bind Var -> [Var]
argsCB Bind Var
cb
  | Bool
otherwise = CoreProgram -> Var -> [Var]
argsP CoreProgram
cbs Var
tlVar

argsCB :: GHC.CoreBind -> [Var]
argsCB :: Bind Var -> [Var]
argsCB (GHC.NonRec Var
_ CoreExpr
e) = CoreExpr -> [Var]
argsE CoreExpr
e
argsCB Bind Var
_                = String -> [Var]
forall a. HasCallStack => String -> a
error String
" [ argsCB ] "

argsE :: GHC.CoreExpr -> [Var]
argsE :: CoreExpr -> [Var]
argsE (GHC.Lam Var
a CoreExpr
e) = Var
a Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
: CoreExpr -> [Var]
argsE CoreExpr
e 
argsE (GHC.Let (GHC.NonRec Var
_ CoreExpr
_) CoreExpr
e) = CoreExpr -> [Var]
argsE CoreExpr
e
argsE CoreExpr
_ = [] 

notrace :: String -> a -> a 
notrace :: String -> a -> a
notrace String
_ a
a = a
a