let app = SrcLoc.noLoc $ HsExpr.HsApp (from_int_t) (undef)
let int_ty = SrcLoc.noLoc $ HsTypes.HsTyVar TysWiredIn.intTyCon_RDR
let expr = HsExpr.ExprWithTySig app int_ty
- let foo_name = mkRdrName "Types.Data.Num" "foo"
- let foo_bind_name = RdrName.mkRdrUnqual $ OccName.mkVarOcc "foo"
- let binds = Bag.listToBag [SrcLoc.noLoc $ HsBinds.VarBind foo_bind_name (SrcLoc.noLoc $ HsExpr.HsVar foo_name)]
- let letexpr = HsExpr.HsLet
- (HsBinds.HsValBinds $ (HsBinds.ValBindsIn binds) [])
- (SrcLoc.noLoc expr)
core <- toCore expr
execCore core
args' <- eitherCoreOrExprArgs args
wrap dst func args'
-idM :: a -> VHDLSession a
-idM e = return e
-
-eitherM :: (a -> m c) -> (b -> m c) -> Either a b -> m c
-eitherM f1 f2 e = do
- case e of
- Left e1 -> f1 e1
- Right e2 -> f2 e2
-
eitherCoreOrExprArgs :: [Either CoreSyn.CoreExpr AST.Expr] -> VHDLSession [AST.Expr]
-eitherCoreOrExprArgs args = mapM (eitherM (\x -> MonadState.lift vsType $ (varToVHDLExpr (exprToVar x))) idM) args
+eitherCoreOrExprArgs args = mapM (Either.either ((MonadState.lift vsType) . varToVHDLExpr . exprToVar) return) args
-- | A function to wrap a builder-like function that expects its arguments to
-- be variables.
-- to run an IO-monad-inside-a-GHC-monad for some reason. I don't really
-- understand what it means, but it works.
env <- GHC.getSession
- let srcspan = SrcLoc.mkGeneralSrcSpan (FastString.fsLit "XXX")
+ let srcspan = SrcLoc.noSrcSpan
hval <- MonadUtils.liftIO $ HscMain.compileExpr env srcspan expr
let res = Unsafe.Coerce.unsafeCoerce hval :: Int
return $ Unsafe.Coerce.unsafeCoerce hval