Permalink
Browse files

usefull interface functions in load.hs

  • Loading branch information...
1 parent 9b5b8df commit 042804ed4688be50e646db00da0adf300efed321 @shayan-najd committed Dec 18, 2012
Showing with 27 additions and 2 deletions.
  1. +1 −1 HTE.cabal
  2. +26 −1 Language/Haskell/THIH/Typecheck/Load.hs
View
2 HTE.cabal
@@ -17,4 +17,4 @@ cabal-version: >=1.8
library
exposed-modules: Language.Haskell.THIH.Syntax, Language.Haskell.THIH.SurfaceTypes, Language.Haskell.THIH.Demotion, Language.Haskell.THIH.BasicTypes, Language.Haskell.THIH.Typecheck.Types, Language.Haskell.THIH.Typecheck.TypeConversions, Language.Haskell.THIH.Typecheck.Typecheck, Language.Haskell.THIH.Typecheck.Load, Language.Haskell.THIH.Typecheck.KindInference, Language.Haskell.THIH.Typecheck.Internals, Language.Haskell.THIH.Typecheck.Demotion, Language.Haskell.THIH.Typecheck.Combinators, Language.Haskell.THIH.Typecheck.Library.Prelude, Language.Haskell.THIH.Typecheck.Library.Monad, Language.Haskell.THIH.Typecheck.Library.Maybe, Language.Haskell.THIH.Typecheck.Library.List, Language.Haskell.Exts.ToTHIH, Language.Haskell.Exts.FromTHIH, Language.Haskell.Exts.Desugaring
-- other-modules:
- build-depends: base ==4.5.*, transformers ==0.3.*, haskell-src-exts, mtl
+ build-depends: base ==4.5.*, transformers ==0.3.*, haskell-src-exts, mtl,deepseq
View
27 Language/Haskell/THIH/Typecheck/Load.hs
@@ -23,8 +23,14 @@ import Language.Haskell.THIH.Typecheck.Library.Prelude
import Language.Haskell.Exts.Desugaring
import Language.Haskell.Exts.ToTHIH
import Language.Haskell.Exts.FromTHIH
+import Language.Haskell.Exts.SrcLoc(noLoc)
+import Control.DeepSeq
+import Control.Applicative
+import System.IO.Unsafe
+import Control.Exception as CE
import Language.Haskell.Exts (ParseResult(..),QName(..),parseType
- ,prettyPrint,Pretty(..),Name(..),parseExp)
+ ,prettyPrint,Pretty(..),Name(..),parseExp,Exp
+ ,ModuleName(..),Decl(PatBind),Rhs(..),Binds(..))
import qualified Language.Haskell.Exts as HSE
import Control.Applicative
@@ -70,6 +76,25 @@ testConversion inp = let
sm = cSModule dm
in
show sm
+
+
+tcHSE :: [Assump] -> HSE.Module -> Maybe [String]
+tcHSE env ast = unsafePerformIO $
+ CE.catch
+ ( do let x = ( (uncurry (++)) $ unzip $
+ (\(x,y) -> (x,prettyPrint y))
+ <$> cAssump
+ <$> tcHSEModule (let (x,y,z) = preludeEnv
+ in (x,y, env ++ z)) ast
+ )
+ deepseq x (return $ Just x)
+ )
+ ((\_ -> return Nothing) :: (SomeException -> IO (Maybe a)))
+
+toModule :: Exp -> HSE.Module
+toModule e = HSE.Module noLoc (ModuleName "Test") [] Nothing Nothing []
+ [PatBind noLoc (HSE.PVar $ Ident "_f") Nothing
+ (UnGuardedRhs e) (BDecls [])]
-----------------------------------------------------
-- Loading
-----------------------------------------------------

0 comments on commit 042804e

Please sign in to comment.