X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;h=c44ed59243ba56dd12b3a362d1914503f13d458e;hb=a8427a4125e9b78e88a487eeabf018f1c6e8bc08;hp=4d9295d6aef56d7f8844aa683fa31ae3533ecc07;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs index 4d9295d..c44ed59 100644 --- a/compiler/deSugar/DsArrows.lhs +++ b/compiler/deSugar/DsArrows.lhs @@ -42,6 +42,8 @@ import Util import HsUtils import VarSet import SrcLoc + +import Data.List \end{code} \begin{code} @@ -586,6 +588,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 vars expr) + = dsLCmd ids local_vars env_ids stack res_ty expr `thenDs` \ (expr1,id_set) -> + mkTickBox ix vars expr1 `thenDs` \ expr2 -> + return (expr2,id_set) + -- A | ys |- c :: [ts] t (ys <= xs) -- --------------------- -- A | xs |- c :: [ts] t ---> arr_ts (\ (xs) -> (ys)) >>> c