From 5ce8aec0615804d8e7da0bf05f64a8669c46dfd2 Mon Sep 17 00:00:00 2001 From: Matthijs Kooijman Date: Fri, 26 Jun 2009 12:36:39 +0200 Subject: [PATCH] Use tcSplitSigmaTy for getting at value arguments. Previously, some handcoded filters with isValArg and isDictId were used, which were not so robust. --- CoreTools.hs | 13 +++++++++++++ VHDL.hs | 3 +-- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/CoreTools.hs b/CoreTools.hs index ed0c52d..3f9b33c 100644 --- a/CoreTools.hs +++ b/CoreTools.hs @@ -10,6 +10,7 @@ import qualified Maybe -- GHC API import qualified GHC import qualified Type +import qualified TcType import qualified HsExpr import qualified HsTypes import qualified HsBinds @@ -164,3 +165,15 @@ has_free_vars = not . VarSet.isEmptyVarSet . CoreFVs.exprFreeVars -- simple Var CoreExprs, not complexer ones. exprToVar :: CoreSyn.CoreExpr -> Var.Id exprToVar (CoreSyn.Var id) = id + +-- Removes all the type and dictionary arguments from the given argument list, +-- leaving only the normal value arguments. The type given is the type of the +-- expression applied to this argument list. +get_val_args :: Type.Type -> [CoreSyn.CoreExpr] -> [CoreSyn.CoreExpr] +get_val_args ty args = drop n args + where + (tyvars, predtypes, _) = TcType.tcSplitSigmaTy ty + -- The first (length tyvars) arguments should be types, the next + -- (length predtypes) arguments should be dictionaries. We drop this many + -- arguments, to get at the value arguments. + n = length tyvars + length predtypes diff --git a/VHDL.hs b/VHDL.hs index b6264dc..8bc67a3 100644 --- a/VHDL.hs +++ b/VHDL.hs @@ -262,8 +262,7 @@ mkConcSm (bndr, Var v) = return $ [mkUncondAssign (Left bndr) (varToVHDLExpr v)] mkConcSm (bndr, app@(CoreSyn.App _ _))= do let (CoreSyn.Var f, args) = CoreSyn.collectArgs app - let valargs' = filter isValArg args - let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs' + let valargs = get_val_args (Var.varType f) args genApplication (Left bndr) f (map Left valargs) -- A single alt case must be a selector. This means thee scrutinee is a simple -- 2.30.2