X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;h=e5b2b557247c1cdd3c0c2648c78019b6440675ec;hp=4d9295d6aef56d7f8844aa683fa31ae3533ecc07;hb=ec3c7841346821c2d5342d0d9c3ff1ae4558aeb6;hpb=dd8c1ab22f0bf0eaa9028f1621ceac02aea96205

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 4d9295d..e5b2b55 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -586,6 +586,12 @@ dsCmd _ids local_vars env_ids _stack _res_ty (HsArrForm op _ args)
     returnDs (mkApps (App core_op (Type env_ty)) core_args,
 	      unionVarSets fv_sets)
 
+
+dsCmd ids local_vars env_ids stack res_ty (HsTick ix expr)
+  = dsLCmd ids local_vars env_ids stack res_ty expr `thenDs` \ (expr1,id_set) ->
+    mkTickBox ix expr1                     	    `thenDs` \ expr2 ->
+    return (expr2,id_set)
+
 --	A | ys |- c :: [ts] t	(ys <= xs)
 --	---------------------
 --	A | xs |- c :: [ts] t	---> arr_ts (\ (xs) -> (ys)) >>> c