-convertToHsExpr :: TH.Exp -> LHsExpr RdrName
-convertToHsExpr = cvtl
-
-cvtl e = noLoc (cvt e)
-
-cvt (VarE s) = HsVar (vName s)
-cvt (ConE s) = HsVar (cName s)
-cvt (LitE l)
- | overloadedLit l = HsOverLit (cvtOverLit l)
- | otherwise = HsLit (cvtLit l)
-
-cvt (AppE x y) = HsApp (cvtl x) (cvtl y)
-cvt (LamE ps e) = HsLam (mkMatchGroup [mkSimpleMatch (map cvtlp ps) (cvtl e)])
-cvt (TupE [e]) = cvt e
-cvt (TupE es) = ExplicitTuple(map cvtl es) Boxed
-cvt (CondE x y z) = HsIf (cvtl x) (cvtl y) (cvtl z)
-cvt (LetE ds e) = HsLet (cvtdecs ds) (cvtl e)
-cvt (CaseE e ms) = HsCase (cvtl e) (mkMatchGroup (map cvtm ms))
-cvt (DoE ss) = HsDo DoExpr (cvtstmts ss) [] void
-cvt (CompE ss) = HsDo ListComp (cvtstmts ss) [] void
-cvt (ArithSeqE dd) = ArithSeqIn (cvtdd dd)
-cvt (ListE xs) = ExplicitList void (map cvtl xs)
-cvt (InfixE (Just x) s (Just y))
- = HsPar (noLoc $ OpApp (cvtl x) (cvtl s) undefined (cvtl y))
-cvt (InfixE Nothing s (Just y)) = SectionR (cvtl s) (cvtl y)
-cvt (InfixE (Just x) s Nothing ) = SectionL (cvtl x) (cvtl s)
-cvt (InfixE Nothing s Nothing ) = cvt s -- Can I indicate this is an infix thing?
-cvt (SigE e t) = ExprWithTySig (cvtl e) (cvtType t)
-cvt (RecConE c flds) = RecordCon (noLoc (cName c)) (map (\(x,y) -> (noLoc (vName x), cvtl y)) flds)
-cvt (RecUpdE e flds) = RecordUpd (cvtl e) (map (\(x,y) -> (noLoc (vName x), cvtl y)) flds)
-
-cvtdecs :: [TH.Dec] -> [HsBindGroup RdrName]
-cvtdecs [] = []
-cvtdecs ds = [HsBindGroup binds sigs Recursive]
+convertToHsExpr :: SrcSpan -> TH.Exp -> LHsExpr RdrName
+convertToHsExpr loc e = cvtl loc e
+
+cvtl loc e = cvt_l e
+ where
+ cvt_l e = L loc (cvt e)
+
+ cvt (VarE s) = HsVar (vName s)
+ cvt (ConE s) = HsVar (cName s)
+ cvt (LitE l)
+ | overloadedLit l = HsOverLit (cvtOverLit l)
+ | otherwise = HsLit (cvtLit l)
+
+ cvt (AppE x y) = HsApp (cvt_l x) (cvt_l y)
+ cvt (LamE ps e) = HsLam (mkMatchGroup [mkSimpleMatch (map (cvtlp loc) ps) (cvtl loc e)])
+ cvt (TupE [e]) = cvt e
+ cvt (TupE es) = ExplicitTuple(map cvt_l es) Boxed
+ cvt (CondE x y z) = HsIf (cvt_l x) (cvt_l y) (cvt_l z)
+ cvt (LetE ds e) = HsLet (cvtdecs loc ds) (cvt_l e)
+ cvt (CaseE e ms) = HsCase (cvt_l e) (mkMatchGroup (map (cvtm loc) ms))
+ cvt (DoE ss) = cvtHsDo loc DoExpr ss
+ cvt (CompE ss) = cvtHsDo loc ListComp ss
+ cvt (ArithSeqE dd) = ArithSeq noPostTcExpr (cvtdd loc dd)
+ cvt (ListE xs) = ExplicitList void (map cvt_l xs)
+ cvt (InfixE (Just x) s (Just y))
+ = HsPar (L loc $ OpApp (cvt_l x) (cvt_l s) undefined (cvt_l y))
+ cvt (InfixE Nothing s (Just y)) = SectionR (cvt_l s) (cvt_l y)
+ cvt (InfixE (Just x) s Nothing ) = SectionL (cvt_l x) (cvt_l s)
+ cvt (InfixE Nothing s Nothing ) = cvt s -- Can I indicate this is an infix thing?
+ cvt (SigE e t) = ExprWithTySig (cvt_l e) (cvtType loc t)
+ cvt (RecConE c flds) = RecordCon (L loc (cName c)) noPostTcExpr
+ (map (\(x,y) -> (L loc (vName x), cvt_l y)) flds)
+ cvt (RecUpdE e flds) = RecordUpd (cvt_l e) (map (\(x,y) -> (L loc (vName x), cvt_l y)) flds)
+ placeHolderType placeHolderType
+
+cvtHsDo loc do_or_lc stmts
+ = HsDo do_or_lc (init stmts') body void
+ where
+ stmts' = cvtstmts loc stmts
+ body = case last stmts' of
+ L _ (ExprStmt body _ _) -> body
+
+cvtdecs :: SrcSpan -> [TH.Dec] -> HsLocalBinds RdrName
+cvtdecs loc [] = EmptyLocalBinds
+cvtdecs loc ds = HsValBinds (ValBindsIn binds sigs)