-convertToHsExpr :: Meta.Exp -> HsExpr RdrName
-convertToHsExpr = cvt
-
-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 x) (cvt y)
-cvt (LamE ps e) = HsLam (mkSimpleMatch (map cvtp ps) (cvt e) void loc0)
-cvt (TupE [e]) = cvt e
-cvt (TupE es) = ExplicitTuple(map cvt es) Boxed
-cvt (CondE x y z) = HsIf (cvt x) (cvt y) (cvt z) loc0
-cvt (LetE ds e) = HsLet (cvtdecs ds) (cvt e)
-cvt (CaseE e ms) = HsCase (cvt e) (map cvtm ms) loc0
-cvt (DoE ss) = HsDo DoExpr (cvtstmts ss) [] void loc0
-cvt (CompE ss) = HsDo ListComp (cvtstmts ss) [] void loc0
-cvt (ArithSeqE dd) = ArithSeqIn (cvtdd dd)
-cvt (ListE xs) = ExplicitList void (map cvt xs)
-cvt (InfixE (Just x) s (Just y))
- = HsPar (OpApp (cvt x) (cvt s) undefined (cvt y))
-cvt (InfixE Nothing s (Just y)) = SectionR (cvt s) (cvt y)
-cvt (InfixE (Just x) s Nothing ) = SectionL (cvt x) (cvt s)
-cvt (InfixE Nothing s Nothing ) = cvt s -- Can I indicate this is an infix thing?
-cvt (SigE e t) = ExprWithTySig (cvt e) (cvtType t)
-cvt (RecConE c flds) = RecordCon (cName c) (map (\(x,y) -> (vName x, cvt y)) flds)
-cvt (RecUpdE e flds) = RecordUpd (cvt e) (map (\(x,y) -> (vName x, cvt y)) flds)
-
-cvtdecs :: [Meta.Dec] -> HsBinds RdrName
-cvtdecs [] = EmptyBinds
-cvtdecs ds = MonoBind 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)