...
 
Commits (2)
......@@ -457,9 +457,6 @@ tcPDeclGroup ps [(i, ExternalDecl p fs)] = do
tcPDeclGroup ps [(i, FreeDecl p fvs)] = do
vs <- mapM (tcDeclVar False) (bv fvs)
m <- getModuleIdent
-- MARK
-- modifyValueEnv $ flip (bindVars m) vs
-- return (ps, [(i, FreeDecl p (map (\(v, _, ForAll _ pty) -> Var pty v) vs))])
(vs', ps') <- unzip <$> mapM addDataPred vs
modifyValueEnv $ flip (bindVars m) vs'
let d = FreeDecl p (map (\(v, _, ForAll _ ty) -> Var ty v) vs')
......@@ -1039,8 +1036,6 @@ tcPatternHelper _ (VariablePattern spi _ v) = do
tcPatternHelper p t@(ConstructorPattern spi _ c ts) = do
m <- lift getModuleIdent
vEnv <- lift getValueEnv
-- MARK
-- (ps, (tys, ty')) <- fmap arrowUnapply <$> lift (skol (constrType m c vEnv))
(ps, (tys, ty')) <- fmap arrowUnapply <$> lift (skol (constrType m c vEnv))
(ps', ts') <- mapAccumM (uncurry . ptcPatternArg p "pattern" (pPrintPrec 0 t))
ps (zip tys ts)
......@@ -1055,8 +1050,6 @@ tcPatternHelper p (ParenPattern spi t) = do
tcPatternHelper _ t@(RecordPattern spi _ c fs) = do
m <- lift getModuleIdent
vEnv <- lift getValueEnv
-- MARK
-- (ps, ty) <- fmap arrowBase <$> lift (skol (constrType m c vEnv))
(ps, ty) <- fmap arrowBase <$> lift (skol (constrType m c vEnv))
-- tcField does not support passing "used" variables, thus we do it by hand
used <- S.get
......
......@@ -207,11 +207,12 @@ dataEqOpExpr i1 es1 i2 es2
deriveAValue :: Type -> [ConstrInfo] -> PredSet -> DVM (Decl PredType)
deriveAValue ty cis ps = do
pty <- getInstMethodType ps qDataId ty aValueId
let inty = instType ty
return $ FunctionDecl NoSpanInfo pty aValueId $
if null cis
then [mkEquation NoSpanInfo aValueId [] $
preludeFailed $ instType ty]
else map (deriveAValueEquation ty) cis
preludeFailed inty]
else map (deriveAValueEquation inty) cis
deriveAValueEquation :: Type -> ConstrInfo -> Equation PredType
deriveAValueEquation ty (arity, cns, _, tys)
......