[commit: ghc] wip/gadtpm: More haddock-compatible comments (d1f8a3f)
git at git.haskell.org
git at git.haskell.org
Sat Nov 28 18:50:32 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/gadtpm
Link : http://ghc.haskell.org/trac/ghc/changeset/d1f8a3fe30560c703047b3d275cb1b19087f6b4a/ghc
>---------------------------------------------------------------
commit d1f8a3fe30560c703047b3d275cb1b19087f6b4a
Author: George Karachalias <george.karachalias at gmail.com>
Date: Sat Nov 28 14:50:13 2015 +0100
More haddock-compatible comments
>---------------------------------------------------------------
d1f8a3fe30560c703047b3d275cb1b19087f6b4a
compiler/deSugar/Check.hs | 56 ++++++++++++++++++++++++++---------------------
1 file changed, 31 insertions(+), 25 deletions(-)
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 57343ff..6fb673c 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -71,9 +71,9 @@ The algorithm used is described in the paper:
type PmM a = DsM a
-data PmConstraint = TmConstraint Id PmExpr -- Term equalities: x ~ e
- | TyConstraint [EvVar] -- Type equalities
- | BtConstraint Id -- Strictness constraints: x ~ _|_
+data PmConstraint = TmConstraint Id PmExpr -- ^ Term equalities: x ~ e
+ | TyConstraint [EvVar] -- ^ Type equalities
+ | BtConstraint Id -- ^ Strictness constraints: x ~ _|_
-- The *arity* of a PatVec [p1,..,pn] is
-- the number of p1..pn that are not Guards
@@ -91,8 +91,8 @@ data PmPat p = PmCon { pm_con_con :: DataCon
-- MkT :: forall p q. (Eq p, Ord q) => p -> q -> T [p]
-- or MkT :: forall p q r. (Eq p, Ord q, [p] ~ r) => p -> q -> T r
-data Pattern = PmGuard PatVec PmExpr -- Guard Patterns
- | NonGuard (PmPat Pattern) -- Other Patterns
+data Pattern = PmGuard PatVec PmExpr -- ^ Guard Patterns
+ | NonGuard (PmPat Pattern) -- ^ Other Patterns
newtype ValAbs = VA (PmPat ValAbs) -- Value Abstractions
@@ -111,15 +111,15 @@ data ValSetAbs -- Reprsents a set of value vector abstractions
-- INVARIANT VsaInvariant: an empty ValSetAbs is always represented by Empty
-- INVARIANT VsaArity: the number of Cons's in any path to a leaf is the same
-- The *arity* of a ValSetAbs is the number of Cons's in any path to a leaf
- = Empty -- {}
- | Union ValSetAbs ValSetAbs -- S1 u S2
- | Singleton -- { |- empty |> empty }
- | Constraint [PmConstraint] ValSetAbs -- Extend Delta
- | Cons ValAbs ValSetAbs -- map (ucon u) vs
+ = Empty -- ^ {}
+ | Union ValSetAbs ValSetAbs -- ^ S1 u S2
+ | Singleton -- ^ { |- empty |> empty }
+ | Constraint [PmConstraint] ValSetAbs -- ^ Extend Delta
+ | Cons ValAbs ValSetAbs -- ^ map (ucon u) vs
-type PmResult = ( [[LPat Id]] -- redundant clauses
- , [[LPat Id]] -- clauses with inaccessible rhs
- , [([PmExpr], [ComplexEq])] ) -- missing
+type PmResult = ( [[LPat Id]] -- ^ redundant clauses
+ , [[LPat Id]] -- ^ clauses with inaccessible rhs
+ , [([PmExpr], [ComplexEq])] ) -- ^ missing
{-
%************************************************************************
@@ -182,7 +182,7 @@ initial_uncovered vars = do
-}
-- -----------------------------------------------------------------------
--- | Utilities
+-- * Utilities
nullaryConPattern :: DataCon -> Pattern
-- Nullary data constructor and nullary type constructor
@@ -234,16 +234,18 @@ oStrToHsLit_mb olit
| otherwise = Nothing
-- -----------------------------------------------------------------------
--- | Transform a Pat Id into a list of (PmPat Id) -- Note [Translation to PmPat]
+-- * Transform (Pat Id) into of (PmPat Id)
translatePat :: Pat Id -> UniqSM PatVec
translatePat pat = case pat of
WildPat ty -> mkPatternVarsSM [ty]
VarPat id -> return [idPatternVar (unLoc id)]
ParPat p -> translatePat (unLoc p)
- LazyPat _ -> mkPatternVarsSM [hsPatType pat] -- translatePat (unLoc p) -- COMEHERE: We ignore laziness for now
- BangPat p -> translatePat (unLoc p) -- COMEHERE: We ignore strictness for now
- -- This might affect the divergence checks?
+ LazyPat _ -> mkPatternVarsSM [hsPatType pat]
+
+ -- ignore strictness annotations for now
+ BangPat p -> translatePat (unLoc p)
+
AsPat lid p -> do
ps <- translatePat (unLoc p)
let [e] = map valAbsToPmExpr (coercePatVec ps) -- Note [Translating As Patterns]
@@ -371,7 +373,7 @@ translateConPatVec univ_tys ex_tvs c (RecCon (HsRecFields fs _))
pvec <- translatePat pat
return (x, pvec)
- let zipped = zip orig_lbls [ x | NonGuard (PmVar x) <- arg_var_pats ] -- [(Name, Id)]
+ let zipped = zip orig_lbls [ x | NonGuard (PmVar x) <- arg_var_pats ]
guards = map (\(name,pvec) -> case lookup name zipped of
Just x -> PmGuard pvec (PmExprVar x)
Nothing -> panic "translateConPatVec: lookup")
@@ -407,7 +409,7 @@ translateMatch (L _ (Match _ lpats _ grhss)) = do
guards = map extractGuards (grhssGRHSs grhss)
-- -----------------------------------------------------------------------
--- | Transform source guards (GuardStmt Id) to PmPats (Pattern)
+-- * Transform source guards (GuardStmt Id) to PmPats (Pattern)
translateGuards :: [GuardStmt Id] -> UniqSM PatVec
translateGuards guards = do
@@ -436,6 +438,7 @@ translateGuards guards = do
| isNotPmExprOther e = True -- expensive but we want it
shouldKeep _other_pat = False -- let the rest..
+-- | Translate a guard statement to Pattern
translateGuard :: GuardStmt Id -> UniqSM PatVec
translateGuard (BodyStmt e _ _ _) = translateBoolGuard e
translateGuard (LetStmt binds) = translateLet (unLoc binds)
@@ -446,17 +449,20 @@ translateGuard (TransStmt {}) = panic "translateGuard TransStmt"
translateGuard (RecStmt {}) = panic "translateGuard RecStmt"
translateGuard (ApplicativeStmt {}) = panic "translateGuard ApplicativeLastStmt"
+-- | Translate let-bindings
translateLet :: HsLocalBinds Id -> UniqSM PatVec
translateLet _binds = return [] -- NOT CORRECT: A let cannot fail so in a way we
-- are fine with it but it can bind things which we do not bring in scope.
-- Hence, they are free while they shouldn't. More constraints would make it
- -- more expressive but omitting some is always safe (Is it? Make sure it is)
+ -- more expressive but omitting some is always safe
+-- | Translate a pattern guard
translateBind :: LPat Id -> LHsExpr Id -> UniqSM PatVec
translateBind (L _ p) e = do
ps <- translatePat p
return [mkGuard ps (unLoc e)]
+-- | Translate a boolean guard
translateBoolGuard :: LHsExpr Id -> UniqSM PatVec
translateBoolGuard e
| isJust (isTrueLHsExpr e) = return []
@@ -474,7 +480,7 @@ translateBoolGuard e
-}
-- ----------------------------------------------------------------------------
--- | Process a vector
+-- * Process a vector
-- Covered, Uncovered, Divergent
process_guards :: UniqSupply -> [PatVec] -> (ValSetAbs, ValSetAbs, ValSetAbs)
@@ -495,7 +501,7 @@ process_guards us gs
(css, uss, dss) = go us4 us gvs
-- ----------------------------------------------------------------------------
--- | Basic utilities
+-- * Basic utilities
patternType :: Pattern -> Type
patternType (PmGuard pv _) = ASSERT (patVecArity pv == 1) (patternType p)
@@ -652,7 +658,7 @@ mkPmId2FormsSM ty = do
return (idPatternVar x, noLoc (HsVar (noLoc x)))
-- ----------------------------------------------------------------------------
--- | Converting between Value Abstractions, Patterns and PmExpr
+-- * Converting between Value Abstractions, Patterns and PmExpr
valAbsToPmExpr :: ValAbs -> PmExpr
valAbsToPmExpr (VA va) = pmPatToPmExpr va
@@ -826,7 +832,7 @@ uncovered us gvsa vec vsa = pmTraverse us gvsa uMatcher vec vsa
divergent us gvsa vec vsa = pmTraverse us gvsa dMatcher vec vsa
-- ----------------------------------------------------------------------------
--- | Generic traversal function
+-- * Generic traversal function
--
-- | Because we represent Value Set Abstractions as a different datatype, more
-- cases than the ones described in the paper appear. Since they are the same
More information about the ghc-commits
mailing list