head 1.3; access; symbols pkgsrc-2013Q3:1.2.0.72 pkgsrc-2013Q3-base:1.2 pkgsrc-2013Q2:1.2.0.70 pkgsrc-2013Q2-base:1.2 pkgsrc-2013Q1:1.2.0.68 pkgsrc-2013Q1-base:1.2 pkgsrc-2012Q4:1.2.0.66 pkgsrc-2012Q4-base:1.2 pkgsrc-2012Q3:1.2.0.64 pkgsrc-2012Q3-base:1.2 pkgsrc-2012Q2:1.2.0.62 pkgsrc-2012Q2-base:1.2 pkgsrc-2012Q1:1.2.0.60 pkgsrc-2012Q1-base:1.2 pkgsrc-2011Q4:1.2.0.58 pkgsrc-2011Q4-base:1.2 pkgsrc-2011Q3:1.2.0.56 pkgsrc-2011Q3-base:1.2 pkgsrc-2011Q2:1.2.0.54 pkgsrc-2011Q2-base:1.2 pkgsrc-2011Q1:1.2.0.52 pkgsrc-2011Q1-base:1.2 pkgsrc-2010Q4:1.2.0.50 pkgsrc-2010Q4-base:1.2 pkgsrc-2010Q3:1.2.0.48 pkgsrc-2010Q3-base:1.2 pkgsrc-2010Q2:1.2.0.46 pkgsrc-2010Q2-base:1.2 pkgsrc-2010Q1:1.2.0.44 pkgsrc-2010Q1-base:1.2 pkgsrc-2009Q4:1.2.0.42 pkgsrc-2009Q4-base:1.2 pkgsrc-2009Q3:1.2.0.40 pkgsrc-2009Q3-base:1.2 pkgsrc-2009Q2:1.2.0.38 pkgsrc-2009Q2-base:1.2 pkgsrc-2009Q1:1.2.0.36 pkgsrc-2009Q1-base:1.2 pkgsrc-2008Q4:1.2.0.34 pkgsrc-2008Q4-base:1.2 pkgsrc-2008Q3:1.2.0.32 pkgsrc-2008Q3-base:1.2 cube-native-xorg:1.2.0.30 cube-native-xorg-base:1.2 pkgsrc-2008Q2:1.2.0.28 pkgsrc-2008Q2-base:1.2 cwrapper:1.2.0.26 pkgsrc-2008Q1:1.2.0.24 pkgsrc-2008Q1-base:1.2 pkgsrc-2007Q4:1.2.0.22 pkgsrc-2007Q4-base:1.2 pkgsrc-2007Q3:1.2.0.20 pkgsrc-2007Q3-base:1.2 pkgsrc-2007Q2:1.2.0.18 pkgsrc-2007Q2-base:1.2 pkgsrc-2007Q1:1.2.0.16 pkgsrc-2007Q1-base:1.2 pkgsrc-2006Q4:1.2.0.14 pkgsrc-2006Q4-base:1.2 pkgsrc-2006Q3:1.2.0.12 pkgsrc-2006Q3-base:1.2 pkgsrc-2006Q2:1.2.0.10 pkgsrc-2006Q2-base:1.2 pkgsrc-2006Q1:1.2.0.8 pkgsrc-2006Q1-base:1.2 pkgsrc-2005Q4:1.2.0.6 pkgsrc-2005Q4-base:1.2 pkgsrc-2005Q3:1.2.0.4 pkgsrc-2005Q3-base:1.2 pkgsrc-2005Q2:1.2.0.2 pkgsrc-2005Q2-base:1.2 pkgsrc-2005Q1:1.1.0.10 pkgsrc-2005Q1-base:1.1 pkgsrc-2004Q4:1.1.0.8 pkgsrc-2004Q4-base:1.1 pkgsrc-2004Q3:1.1.0.6 pkgsrc-2004Q3-base:1.1 pkgsrc-2004Q2:1.1.0.4 pkgsrc-2004Q2-base:1.1 pkgsrc-2004Q1:1.1.0.2 pkgsrc-2004Q1-base:1.1; locks; strict; comment @# @; 1.3 date 2013.10.25.04.09.14; author dholland; state dead; branches; next 1.2; commitid Qvi785A4qCXpYCax; 1.2 date 2005.05.01.22.55.07; author kristerw; state Exp; branches; next 1.1; 1.1 date 2004.01.16.00.59.18; author kristerw; state Exp; branches; next ; desc @@ 1.3 log @Commit partial update to 1.22 so I can work on it on multiple machines. Doesn't build yet, so leave the package marked BROKEN. @ text @$NetBSD: patch-ag,v 1.2 2005/05/01 22:55:07 kristerw Exp $ --- src/compiler98/RenameLib.hs 22 Dec 2004 12:58:35 -0000 1.31 +++ src/compiler98/RenameLib.hs 11 Apr 2005 14:24:49 -0000 @@@@ -216,7 +216,7 @@@@ (coni:_) -> case (ntI . dropJust . lookupAT st ) coni of (NewType _ [] _ [NTcons c _ _,res]) -> (synType,(u,c):newType) - (NewType _ [] _ [NTvar v _,res]) -> (synType,(u,v):newType) + (NewType _ [] _ [NTvar v _,res]) -> (synType, newType) (NewType _ [] _ [NTapp v1 v2,res]) -> (synType,newType) -- ^ MW hack: omits potential circularity check! (NewType _ [] _ (_:_:_)) -> @ 1.2 log @Update nhc98 to 1.18. Changes from 1.16: # New: Several more packages of hierarchical libraries are included in the build: base, parsec, haskell-src, QuickCheck, HaXml, HUnit, Cabal. # New: FFI improvements: foreign import "dynamic" is now supported, and named C header-files are now used. # New: The compiler now uses cpphs for Haskell source instead of cpp. This removes problems with string gaps, primes in identifiers, and so on. # New: In hmake-interactive, if the readline library is not available, the simple line editor now has a history mechanism. # Bugfix: hmake's processing of cpp conditional directives is improved also. # Bugfix: More evil bugfixes for gcc versions ? 3.3 # Bugfix: A numeric pattern can now match against a Num newtype. # Bugfix: Foreign imports and abstract newtypes now play OK together. # Bugfix: Methods in qualified classes no longer need to be qualified in instance decls. # Bugfix: GreenCard now accepts <<.../...>> syntax. @ text @d1 1 a1 1 $NetBSD$ @ 1.1 log @Add patches from the nhc98 web page: * A degenerate type synonym like type T a = a in some circumstances incorrectly caused an occurence check error. * Several new features in gcc-3.3 cause breakage in the nhc98 build. This patch fixes many [but ot all] of those problems. PKGREVISION++. @ text @d3 11 a13 131 --- src/compiler98/TypeUnify.hs.orig 20 Feb 2003 18:23:29 +++ src/compiler98/TypeUnify.hs 1 Apr 2003 13:54:36 @@@@ -3,7 +3,7 @@@@ -} module TypeUnify(unify,unifyr) where -import NT(NT(..),NewType(..),freeNT,strNT) +import NT(NT(..),NewType(..),freeNT,strNT,anyVarNT) import IdKind import TypeSubst import TypeUtil @@@@ -20,12 +20,12 @@@@ unify state phi (t1@@(NTany tvn1),t2) = case applySubst phi tvn1 of - Nothing -> extend phi tvn1 (subst phi t2) + Nothing -> extendV state phi tvn1 (subst phi t2) Just phitvn -> unify state phi (phitvn,subst phi t2) unify state phi (t1@@(NTvar tvn1),(NTany tvn2)) = case applySubst phi tvn2 of - Nothing -> extend phi tvn2 (subst phi t1) + Nothing -> extendV state phi tvn2 (subst phi t1) Just phitvn -> unify state phi (phitvn,subst phi t1) unify state phi (t1@@(NTvar tvn1),t2) = @@@@ -35,7 +35,7 @@@@ unify state phi (t1@@(NTcons _ _),t2@@(NTany tvn2)) = case applySubst phi tvn2 of - Nothing -> extend phi tvn2 (subst phi t1) + Nothing -> extendV state phi tvn2 (subst phi t1) Just phitvn -> unify state phi (phitvn,subst phi t1) unify state phi (t1@@(NTcons _ _),t2@@(NTvar tvn2)) = @@@@ -81,13 +81,13 @@@@ unify state phi (t1@@(NTapp ta1 tb1),t2@@(NTany tvn2)) = -- strace ("unify(2) " ++ show t1 ++ " " ++ show t2) $ case applySubst phi tvn2 of - Nothing -> extend phi tvn2 (subst phi t1) + Nothing -> extendV state phi tvn2 (subst phi t1) Just phitvn -> unify state phi (phitvn,subst phi t1) unify state phi (t1@@(NTapp ta1 tb1),t2@@(NTvar tvn2)) = -- strace ("unify(3) " ++ show t1 ++ " " ++ show t2) $ case applySubst phi tvn2 of - Nothing -> extend phi tvn2 (subst phi t1) + Nothing -> extendV state phi tvn2 (subst phi t1) Just phitvn -> unify state phi (phitvn,subst phi t1) unify state phi (t1@@(NTapp ta1 tb1),t2@@(NTcons c2 ts2)) = @@@@ -130,7 +130,7 @@@@ unify state phi (t1@@(NTexist e),t2@@(NTany tvn2)) = -- strace ("unify exist " ++ show e ++ " any " ++ show tvn2) $ case applySubst phi tvn2 of - Nothing -> extend phi tvn2 (subst phi t1) + Nothing -> extendV state phi tvn2 (subst phi t1) Just phitvn -> unify state phi (phitvn,subst phi t1) unify state phi (t1@@(NTexist e),t2@@(NTvar tvn2)) = @@@@ -166,6 +166,8 @@@@ ------ +-- expand any type synonym at top, so that none is at top in result +expandAll :: IntState -> NT -> NT expandAll state t@@(NTcons tcon ts) = case unifyExpand state tcon of Left _ -> t @@@@ -178,6 +180,15 @@@@ Right _ -> False Left _ -> True +-- expand all type synonyms, so that none is left in result +fullyExpand :: IntState -> NT -> NT +fullyExpand state t = + case expandAll state t of + NTstrict t -> NTstrict (fullyExpand state t) + NTapp t1 t2 -> NTapp (fullyExpand state t1) (fullyExpand state t2) + NTcons id ts -> NTcons id (map (fullyExpand state) ts) + t -> t + {- If tcon is a type synoym, then unifyExpand returns the depth and the definition body of the type synoym. @@@@ -205,27 +216,26 @@@@ expand (NewType free [] ctxs [nt]) ts = subst (list2Subst (zip free ts)) nt - +{- +Extends substitution by subtitution of `t' for `tvn'. +Performs occurrence check and assures that replacement of `tvn' is a type +variable, if `t' expands to a type variable. +-} extendV :: IntState -> AssocTree Id NT -> Id -> NT -> Either (AssocTree Id NT, String) (AssocTree Id NT) -extendV state phi tvn t@@(NTcons c _) = - if unboxedIS state c then - Left (phi,"polymorphic type variable bound to unboxed data " ++ strIS state c) - else - extend phi tvn t extendV state phi tvn t = - extend phi tvn t + let t' = expandAll state t + in case anyVarNT t' of + Just tvn' -> if tvn' == tvn + then Right phi + else Right (addSubst phi tvn t') + Nothing -> + if tvn `elem` freeNT t' + then let t'' = fullyExpand state t' + -- expansion may have less free variables + in if tvn `elem` freeNT t'' + then Left (phi,"(type-variable occurrence check fails)") + else Right (addSubst phi tvn t'') + else Right (addSubst phi tvn t) -- do not expand unnecessarily -extend phi tvn t@@(NTany tvn') = - if tvn' == tvn - then Right phi - else Right (addSubst phi tvn t) -extend phi tvn t@@(NTvar tvn') = - if tvn' == tvn - then Right phi - else Right (addSubst phi tvn t) -extend phi tvn t | tvn `elem` freeNT t = - Left (phi,"(type-variable occurrence check fails)") -extend phi tvn t@@(NTcons c _) = Right (addSubst phi tvn t) -extend phi tvn t = Right (addSubst phi tvn t) @