diff options
author | Ben Lippmeier <benl@ouroborus.net> | 2010-11-26 04:29:00 +0000 |
---|---|---|
committer | Ben Lippmeier <benl@ouroborus.net> | 2010-11-26 04:29:00 +0000 |
commit | d70f8919d9fde9bf0ec1438cafb617588400e09c (patch) | |
tree | 82dadb2464db395356a5a09acf8a336369d72827 /compiler | |
parent | 12a9114180eaf776c987026eac87adf5f84918ad (diff) | |
download | haskell-d70f8919d9fde9bf0ec1438cafb617588400e09c.tar.gz |
vectoriser: take class directly from the instance tycon
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/vectorise/Vectorise/Type/PADict.hs | 21 |
1 files changed, 6 insertions, 15 deletions
diff --git a/compiler/vectorise/Vectorise/Type/PADict.hs b/compiler/vectorise/Vectorise/Type/PADict.hs index 8b6ad92c3e..a15f671352 100644 --- a/compiler/vectorise/Vectorise/Type/PADict.hs +++ b/compiler/vectorise/Vectorise/Type/PADict.hs @@ -53,21 +53,12 @@ buildPADict vect_tc prepr_tc arr_tc repr $ Type inst_ty : map (method_call args) method_ids -- Build the type of the dictionary function. - pa_tc <- builtin paTyCon - let pa_opitems = [(id, NoDefMeth) | id <- method_ids] - let pa_cls = mkClass - (tyConName pa_tc) - tvs -- tyvars of class - [] -- fundeps - [] -- superclass predicates - 0 -- number of equalities - [] -- superclass dict selectors - [] -- associated type families - pa_opitems -- class op items - pa_tc -- dictionary type constructor - - let dfun_ty = mkForAllTys tvs - $ mkFunTys (map varType args) (PredTy $ ClassP pa_cls [inst_ty]) + pa_tc <- builtin paTyCon + let pa_opitems = [(id, NoDefMeth) | id <- method_ids] + let Just pa_cls = tyConClass_maybe pa_tc + + let dfun_ty = mkForAllTys tvs + $ mkFunTys (map varType args) (PredTy $ ClassP pa_cls [inst_ty]) -- Set the unfolding for the inliner. raw_dfun <- newExportedVar dfun_name dfun_ty |