summaryrefslogtreecommitdiff
path: root/compiler/deSugar
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/deSugar')
-rw-r--r--compiler/deSugar/Coverage.hs5
-rw-r--r--compiler/deSugar/DsArrows.hs2
-rw-r--r--compiler/deSugar/DsCCall.hs3
-rw-r--r--compiler/deSugar/DsForeign.hs2
-rw-r--r--compiler/deSugar/DsMeta.hs23
-rw-r--r--compiler/deSugar/MatchLit.hs6
6 files changed, 21 insertions, 20 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index b96491231a..51bfb1811d 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -888,9 +888,10 @@ addTickHsCmd (HsCmdArrApp e1 e2 ty1 arr_ty lr) =
(return ty1)
(return arr_ty)
(return lr)
-addTickHsCmd (HsCmdArrForm e fix cmdtop) =
- liftM3 HsCmdArrForm
+addTickHsCmd (HsCmdArrForm e f fix cmdtop) =
+ liftM4 HsCmdArrForm
(addTickLHsExpr e)
+ (return f)
(return fix)
(mapM (liftL (addTickHsCmdTop)) cmdtop)
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index 0ce6f50656..16ec704ad8 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -607,7 +607,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdDo (L _ stmts) _) env_ids = do
-- -----------------------------------
-- D; xs |-a (|e c1 ... cn|) :: stk --> t ---> e [t_xs] c1 ... cn
-dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ args) env_ids = do
+dsCmd _ids local_vars _stack_ty _res_ty (HsCmdArrForm op _ _ args) env_ids = do
let env_ty = mkBigCoreVarTupTy env_ids
core_op <- dsLExpr op
(core_args, fv_sets) <- mapAndUnzipM (dsTrimCmdArg local_vars env_ids) args
diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs
index 0d9bbb4362..d87d93527a 100644
--- a/compiler/deSugar/DsCCall.hs
+++ b/compiler/deSugar/DsCCall.hs
@@ -37,7 +37,6 @@ import TysPrim
import TyCon
import TysWiredIn
import BasicTypes
-import FastString ( unpackFS )
import Literal
import PrelNames
import DynFlags
@@ -95,7 +94,7 @@ dsCCall lbl args may_gc result_ty
uniq <- newUnique
dflags <- getDynFlags
let
- target = StaticTarget (unpackFS lbl) lbl Nothing True
+ target = StaticTarget NoSourceText lbl Nothing True
the_fcall = CCall (CCallSpec target CCallConv may_gc)
the_prim_app = mkFCall dflags uniq the_fcall unboxed_args ccall_result_ty
return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 981745e602..b7ea8ab777 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -218,7 +218,7 @@ dsFCall fn_id co fcall mDeclHeader = do
CApiConv safety) ->
do wrapperName <- mkWrapperName "ghc_wrapper" (unpackFS cName)
let fcall' = CCall (CCallSpec
- (StaticTarget (unpackFS wrapperName)
+ (StaticTarget NoSourceText
wrapperName mUnitId
True)
CApiConv safety)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 556fbf9513..ee64fa73f3 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -944,7 +944,7 @@ repTy :: HsType Name -> DsM (Core TH.TypeQ)
repTy ty@(HsForAllTy {}) = repForall ty
repTy ty@(HsQualTy {}) = repForall ty
-repTy (HsTyVar (L _ n))
+repTy (HsTyVar _ (L _ n))
| isTvOcc occ = do tv1 <- lookupOcc n
repTvar tv1
| isDataOcc occ = do tc1 <- lookupOcc n
@@ -970,7 +970,8 @@ repTy (HsListTy t) = do
repTapp tcon t1
repTy (HsPArrTy t) = do
t1 <- repLTy t
- tcon <- repTy (HsTyVar (noLoc (tyConName parrTyCon)))
+ tcon <- repTy (HsTyVar NotPromoted
+ (noLoc (tyConName parrTyCon)))
repTapp tcon t1
repTy (HsTupleTy HsUnboxedTuple tys) = do
tys1 <- repLTys tys
@@ -995,7 +996,7 @@ repTy (HsKindSig t k) = do
k1 <- repLKind k
repTSig t1 k1
repTy (HsSpliceTy splice _) = repSplice splice
-repTy (HsExplicitListTy _ tys) = do
+repTy (HsExplicitListTy _ _ tys) = do
tys1 <- repLTys tys
repTPromotedList tys1
repTy (HsExplicitTupleTy _ tys) = do
@@ -1041,7 +1042,7 @@ repNonArrowLKind :: LHsKind Name -> DsM (Core TH.Kind)
repNonArrowLKind (L _ ki) = repNonArrowKind ki
repNonArrowKind :: HsKind Name -> DsM (Core TH.Kind)
-repNonArrowKind (HsTyVar (L _ name))
+repNonArrowKind (HsTyVar _ (L _ name))
| isLiftedTypeKindTyConName name = repKStar
| name `hasKey` constraintKindTyConKey = repKConstraint
| isTvOcc (nameOccName name) = lookupOcc name >>= repKVar
@@ -1073,10 +1074,10 @@ repRole (L _ Nothing) = rep2 inferRName []
repSplice :: HsSplice Name -> DsM (Core a)
-- See Note [How brackets and nested splices are handled] in TcSplice
-- We return a CoreExpr of any old type; the context should know
-repSplice (HsTypedSplice n _) = rep_splice n
-repSplice (HsUntypedSplice n _) = rep_splice n
-repSplice (HsQuasiQuote n _ _ _) = rep_splice n
-repSplice e@(HsSpliced _ _) = pprPanic "repSplice" (ppr e)
+repSplice (HsTypedSplice _ n _) = rep_splice n
+repSplice (HsUntypedSplice _ n _) = rep_splice n
+repSplice (HsQuasiQuote n _ _ _) = rep_splice n
+repSplice e@(HsSpliced _ _) = pprPanic "repSplice" (ppr e)
rep_splice :: Name -> DsM (Core a)
rep_splice splice_name
@@ -2345,15 +2346,15 @@ repLiteral lit
mk_integer :: Integer -> DsM HsLit
mk_integer i = do integer_ty <- lookupType integerTyConName
- return $ HsInteger "" i integer_ty
+ return $ HsInteger NoSourceText i integer_ty
mk_rational :: FractionalLit -> DsM HsLit
mk_rational r = do rat_ty <- lookupType rationalTyConName
return $ HsRat r rat_ty
mk_string :: FastString -> DsM HsLit
-mk_string s = return $ HsString "" s
+mk_string s = return $ HsString NoSourceText s
mk_char :: Char -> DsM HsLit
-mk_char c = return $ HsChar "" c
+mk_char c = return $ HsChar NoSourceText c
repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
repOverloadedLiteral (OverLit { ol_val = val})
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index c66021f6b5..9849eec191 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -291,11 +291,11 @@ tidyNPat tidy_lit_pat (OverLit val False _ ty) mb_neg _eq outer_ty
-- which might be ok if we have 'instance IsString Int'
--
| not type_change, isIntTy ty, Just int_lit <- mb_int_lit
- = mk_con_pat intDataCon (HsIntPrim "" int_lit)
+ = mk_con_pat intDataCon (HsIntPrim NoSourceText int_lit)
| not type_change, isWordTy ty, Just int_lit <- mb_int_lit
- = mk_con_pat wordDataCon (HsWordPrim "" int_lit)
+ = mk_con_pat wordDataCon (HsWordPrim NoSourceText int_lit)
| not type_change, isStringTy ty, Just str_lit <- mb_str_lit
- = tidy_lit_pat (HsString "" str_lit)
+ = tidy_lit_pat (HsString NoSourceText str_lit)
-- NB: do /not/ convert Float or Double literals to F# 3.8 or D# 5.3
-- If we do convert to the constructor form, we'll generate a case
-- expression on a Float# or Double# and that's not allowed in Core; see
View Lorry Controller Status