[corrected fixv for parameterized ATs mail@stefanwehr.de**20050713050456] { hunk ./Entailment.hs 68 + +-- +-- NOTE: don't know if entailment is correct. I think I should apply the +-- substitution returned from unification (when checking entailment for +-- eq-constraints) to something. +-- + hunk ./ParseSyntax.hs 298 - fixedTypeVars _ = Set.empty + fixedTypeVars (AssocType id ts) = + -- does not work with multiple parameters classes + Set.unions (map fixedTypeVars (drop 1 ts)) hunk ./TypeInference.hs 518 + do let pi1' = applySubst subst' pi1 + xs <- liftST $ mapM (entail pi2') (pi1' ++ map EC peqs) + if and xs + then do debug "Subsumption succeeded" + return (Just (subst, subst')) + else do debug "Subsumption failed because entailment \ + \failed" + return Nothing +{- hunk ./TypeInference.hs 539 - +-} hunk ./TypeInference.hs 577 - let fv_rho = freeTypeVars rho - fixv_rho = fixedTypeVars rho - in if not ((Set.fromList alphas `Set.intersection` fv_rho) - `Set.isSubsetOf` fixv_rho) + do let fv_rho = freeTypeVars rho + fixv_rho = fixedTypeVars rho + if not ((Set.fromList alphas `Set.intersection` fv_rho) + `Set.isSubsetOf` fixv_rho) hunk ./TypeInference.hs 588 - then phasefail ("ambiguous signature for " ++ showPpr' id - ++ ": " ++ showPpr sc) - else return () - + then phasefail ("ambiguous signature for " ++ showPpr' id + ++ ": " ++ showPpr sc) + else return () + hunk ./tests/examples/Collects.out 1 +sum :: forall a[2] . Num a[2] => List a[2] -> a[2] +sumColl :: forall v[-2] . Collects v[-2], Num (Elem v[-2]) => v[-2] -> Elem v[-2] +main :: Int addfile ./tests/examples/stack.phc hunk ./tests/examples/stack.phc 1 +class STACK a where { + type StackRepr a elem; + emptyStack :: a -> StackRepr a elem; + top :: a -> StackRepr a elem -> elem; + pop :: a -> StackRepr a elem -> StackRepr a elem; + push :: a -> elem -> StackRepr a elem -> StackRepr a elem; +} + +data Stack = Stack; + +instance STACK Stack where { + type StackRepr Stack elem = List elem; + emptyStack _ = Nil; + top _ (Cons x xs) = x; + pop _ (Cons x xs) = xs; + push _ x xs = Cons x xs; +} }