Merge branch 'master' of http://darcs.haskell.org/ghc
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 13 Jun 2011 14:08:15 +0000 (15:08 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 13 Jun 2011 14:08:15 +0000 (15:08 +0100)
23 files changed:
boot
compiler/coreSyn/CoreFVs.lhs
compiler/coreSyn/CoreSubst.lhs
compiler/coreSyn/CoreSyn.lhs
compiler/coreSyn/PprCore.lhs
compiler/deSugar/Desugar.lhs
compiler/hsSyn/HsDecls.lhs
compiler/parser/Lexer.x
compiler/parser/Parser.y.pp
compiler/rename/RnSource.lhs
compiler/simplCore/SimplCore.lhs
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcHsSyn.lhs
compiler/vectorise/Vectorise.hs
compiler/vectorise/Vectorise/Builtins/Prelude.hs
compiler/vectorise/Vectorise/Env.hs
compiler/vectorise/Vectorise/Monad.hs
compiler/vectorise/Vectorise/Monad/Global.hs
mk/config.mk.in
mk/validate-settings.mk
packages
rules/extra-packages.mk
sync-all

diff --git a/boot b/boot
index 0b67b17..08d4846 100755 (executable)
--- a/boot
+++ b/boot
@@ -58,7 +58,7 @@ sub sanity_check_tree {
         if (/^#/) {
             # Comment; do nothing
         }
-        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+ +[^ ]+$/) {
+        elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
             $dir = $1;
             $tag = $2;
 
index c130921..3301722 100644 (file)
@@ -332,8 +332,9 @@ Also since rule_fn is a Name, not a Var, we have to use the grungy delUFM.
 vectsFreeVars :: [CoreVect] -> VarSet
 vectsFreeVars = foldr (unionVarSet . vectFreeVars) emptyVarSet
   where
-    vectFreeVars (Vect _ Nothing)    = noFVs
-    vectFreeVars (Vect _ (Just rhs)) = expr_fvs rhs isLocalId emptyVarSet
+    vectFreeVars (Vect   _ Nothing)    = noFVs
+    vectFreeVars (Vect   _ (Just rhs)) = expr_fvs rhs isLocalId emptyVarSet
+    vectFreeVars (NoVect _)            = noFVs
 \end{code}
 
 
index acf17e3..0c954a8 100644 (file)
@@ -714,8 +714,9 @@ substVects subst = map (substVect subst)
 
 ------------------
 substVect :: Subst -> CoreVect -> CoreVect
-substVect _subst (Vect v Nothing)    = Vect v Nothing
-substVect subst  (Vect v (Just rhs)) = Vect v (Just (simpleOptExprWith subst rhs))
+substVect _subst (Vect   v Nothing)    = Vect   v Nothing
+substVect subst  (Vect   v (Just rhs)) = Vect   v (Just (simpleOptExprWith subst rhs))
+substVect _subst (NoVect v)            = NoVect v
 
 ------------------
 substVarSet :: Subst -> VarSet -> VarSet
index e754c6d..178d5ca 100644 (file)
@@ -417,14 +417,16 @@ Representation of desugared vectorisation declarations that are fed to the vecto
 'ModGuts').
 
 \begin{code}
-data CoreVect = Vect Id (Maybe CoreExpr)
+data CoreVect = Vect   Id (Maybe CoreExpr)
+              | NoVect Id
+
 \end{code}
 
 
 %************************************************************************
-%*                                                                     *
-               Unfoldings
-%*                                                                     *
+%*                                                                      *
+                Unfoldings
+%*                                                                      *
 %************************************************************************
 
 The @Unfolding@ type is declared here to avoid numerous loops
index e9452dc..463f3c9 100644 (file)
@@ -446,7 +446,7 @@ instance Outputable e => Outputable (DFunArg e) where
 \end{code}
 
 -----------------------------------------------------
---     Rules
+--      Rules
 -----------------------------------------------------
 
 \begin{code}
@@ -461,11 +461,23 @@ pprRule (BuiltinRule { ru_fn = fn, ru_name = name})
   = ptext (sLit "Built in rule for") <+> ppr fn <> colon <+> doubleQuotes (ftext name)
 
 pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
-               ru_bndrs = tpl_vars, ru_args = tpl_args,
-               ru_rhs = rhs })
+                ru_bndrs = tpl_vars, ru_args = tpl_args,
+                ru_rhs = rhs })
   = hang (doubleQuotes (ftext name) <+> ppr act)
        4 (sep [ptext (sLit "forall") <+> braces (sep (map pprTypedBinder tpl_vars)),
-              nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
-              nest 2 (ptext (sLit "=") <+> pprCoreExpr rhs)
-           ])
+               nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
+               nest 2 (ptext (sLit "=") <+> pprCoreExpr rhs)
+            ])
+\end{code}
+
+-----------------------------------------------------
+--      Vectorisation declarations
+-----------------------------------------------------
+
+\begin{code}
+instance Outputable CoreVect where
+  ppr (Vect   var Nothing)  = ptext (sLit "VECTORISE SCALAR") <+> ppr var
+  ppr (Vect   var (Just e)) = hang (ptext (sLit "VECTORISE") <+> ppr var <+> char '=')
+                                4 (pprCoreExpr e)
+  ppr (NoVect var)          = ptext (sLit "NOVECTORISE") <+> ppr var
 \end{code}
index 70679fb..af2db36 100644 (file)
@@ -394,16 +394,11 @@ the rule is precisly to optimise them:
 
 \begin{code}
 dsVect :: LVectDecl Id -> DsM CoreVect
-dsVect (L loc (HsVect v rhs))
+dsVect (L loc (HsVect (L _ v) rhs))
   = putSrcSpanDs loc $ 
     do { rhs' <- fmapMaybeM dsLExpr rhs
-       ; return $ Vect (unLoc v) rhs'
+       ; return $ Vect v rhs'
           }
--- dsVect (L loc (HsVect v Nothing))
---   = return $ Vect v Nothing
--- dsVect (L loc (HsVect v (Just rhs)))
---   = putSrcSpanDs loc $ 
---     do { rhs' <- dsLExpr rhs
---        ; return $ Vect v (Just rhs')
---       }
+dsVect (L _loc (HsNoVect (L _ v)))
+  = return $ NoVect v
 \end{code}
index c05f26a..3712cbd 100644 (file)
@@ -28,6 +28,7 @@ module HsDecls (
   collectRuleBndrSigTys,
   -- ** @VECTORISE@ declarations
   VectDecl(..), LVectDecl,
+  lvectDeclName,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
   -- ** Top-level template haskell splice
@@ -1005,10 +1006,11 @@ instance OutputableBndr name => Outputable (RuleBndr name) where
 %*                                                                      *
 %************************************************************************
 
-A vectorisation pragma
+A vectorisation pragma, one of
 
-  {-# VECTORISE f = closure1 g (scalar_map g) #-} OR
+  {-# VECTORISE f = closure1 g (scalar_map g) #-}
   {-# VECTORISE SCALAR f #-}
+  {-# NOVECTORISE f #-}
   
 Note [Typechecked vectorisation pragmas]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1029,14 +1031,23 @@ data VectDecl name
   = HsVect
       (Located name)
       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
+  | HsNoVect
+      (Located name)
   deriving (Data, Typeable)
-      
+
+lvectDeclName :: LVectDecl name -> name
+lvectDeclName (L _ (HsVect   (L _ name) _)) = name
+lvectDeclName (L _ (HsNoVect (L _ name)))   = name
+
 instance OutputableBndr name => Outputable (VectDecl name) where
-  ppr (HsVect v rhs)
+  ppr (HsVect v Nothing)
+    = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
+  ppr (HsVect v (Just rhs))
     = sep [text "{-# VECTORISE" <+> ppr v,
-           nest 4 (case rhs of
-                     Nothing  -> text "SCALAR #-}"
-                     Just rhs -> pprExpr (unLoc rhs) <+> text "#-}") ]
+           nest 4 $ 
+             pprExpr (unLoc rhs) <+> text "#-}" ]
+  ppr (HsNoVect v)
+    = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
 \end{code}
 
 %************************************************************************
index 76a02d6..43a4004 100644 (file)
@@ -483,6 +483,7 @@ data Token
   | ITlanguage_prag
   | ITvect_prag
   | ITvect_scalar_prag
+  | ITnovect_prag
 
   | ITdotdot                   -- reserved symbols
   | ITcolon
@@ -2281,7 +2282,8 @@ oneWordPrags = Map.fromList([("rules", rulePrag),
                            ("core", token ITcore_prag),
                            ("unpack", token ITunpack_prag),
                            ("ann", token ITann_prag),
-                           ("vectorize", token ITvect_prag)])
+                           ("vectorize", token ITvect_prag),
+                           ("novectorize", token ITnovect_prag)])
 
 twoWordPrags = Map.fromList([("inline conlike", token (ITinline_prag Inline ConLike)),
                              ("notinline conlike", token (ITinline_prag NoInline ConLike)),
@@ -2307,6 +2309,7 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag))
                                               "noinline" -> "notinline"
                                               "specialise" -> "specialize"
                                               "vectorise" -> "vectorize"
+                                              "novectorise" -> "novectorize"
                                               "constructorlike" -> "conlike"
                                               _ -> prag'
                           canon_ws s = unwords (map canonical (words s))
index 01d768a..b663ac2 100644 (file)
@@ -252,21 +252,22 @@ incorrect.
  'by'       { L _ ITby }        -- for list transform extension
  'using'    { L _ ITusing }     -- for list transform extension
 
- '{-# INLINE'            { L _ (ITinline_prag _ _) }
- '{-# SPECIALISE'        { L _ ITspec_prag }
+ '{-# INLINE'             { L _ (ITinline_prag _ _) }
+ '{-# SPECIALISE'         { L _ ITspec_prag }
  '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
- '{-# SOURCE'     { L _ ITsource_prag }
- '{-# RULES'      { L _ ITrules_prag }
- '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
- '{-# SCC'        { L _ ITscc_prag }
- '{-# GENERATED'   { L _ ITgenerated_prag }
- '{-# DEPRECATED'  { L _ ITdeprecated_prag }
- '{-# WARNING'     { L _ ITwarning_prag }
- '{-# UNPACK'      { L _ ITunpack_prag }
- '{-# ANN'         { L _ ITann_prag }
+ '{-# SOURCE'                                  { L _ ITsource_prag }
+ '{-# RULES'                                   { L _ ITrules_prag }
+ '{-# CORE'                                    { L _ ITcore_prag }              -- hdaume: annotated core
+ '{-# SCC'                { L _ ITscc_prag }
+ '{-# GENERATED'          { L _ ITgenerated_prag }
+ '{-# DEPRECATED'         { L _ ITdeprecated_prag }
+ '{-# WARNING'            { L _ ITwarning_prag }
+ '{-# UNPACK'             { L _ ITunpack_prag }
+ '{-# ANN'                { L _ ITann_prag }
  '{-# VECTORISE'          { L _ ITvect_prag }
  '{-# VECTORISE_SCALAR'   { L _ ITvect_scalar_prag }
- '#-}'            { L _ ITclose_prag }
+ '{-# NOVECTORISE'        { L _ ITnovect_prag }
+ '#-}'                                         { L _ ITclose_prag }
 
  '..'          { L _ ITdotdot }                        -- reserved symbols
  ':'           { L _ ITcolon }
@@ -546,33 +547,34 @@ ops       :: { Located [Located RdrName] }
 -- Top-Level Declarations
 
 topdecls :: { OrdList (LHsDecl RdrName) }
-        : topdecls ';' topdecl                 { $1 `appOL` $3 }
-        | topdecls ';'                         { $1 }
-       | topdecl                               { $1 }
+        : topdecls ';' topdecl                  { $1 `appOL` $3 }
+        | topdecls ';'                          { $1 }
+        | topdecl                               { $1 }
 
 topdecl :: { OrdList (LHsDecl RdrName) }
-       : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
-       | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
-       | 'instance' inst_type where_inst
-           { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
-             in 
-             unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
+        : cl_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
+        | ty_decl                       { unitOL (L1 (TyClD (unLoc $1))) }
+        | 'instance' inst_type where_inst
+            { let (binds, sigs, ats, _) = cvBindsAndSigs (unLoc $3)
+              in 
+              unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs ats)))}
         | stand_alone_deriving                  { unitOL (LL (DerivD (unLoc $1))) }
-       | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
-       | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
+        | 'default' '(' comma_types0 ')'        { unitOL (LL $ DefD (DefaultDecl $3)) }
+        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
         | '{-# DEPRECATED' deprecations '#-}'   { $2 }
         | '{-# WARNING' warnings '#-}'          { $2 }
-       | '{-# RULES' rules '#-}'               { $2 }
-       | '{-# VECTORISE_SCALAR' qvar '#-}'     { unitOL $ LL $ VectD (HsVect $2 Nothing) }
-       | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect $2 (Just $4)) }
-       | annotation { unitOL $1 }
-       | decl                                  { unLoc $1 }
-
-       -- Template Haskell Extension
-       -- The $(..) form is one possible form of infixexp
-       -- but we treat an arbitrary expression just as if 
-       -- it had a $(..) wrapped around it
-       | infixexp                              { unitOL (LL $ mkTopSpliceDecl $1) } 
+        | '{-# RULES' rules '#-}'               { $2 }
+        | '{-# VECTORISE_SCALAR' qvar '#-}'     { unitOL $ LL $ VectD (HsVect   $2 Nothing) }
+        | '{-# VECTORISE' qvar '=' exp '#-}'    { unitOL $ LL $ VectD (HsVect   $2 (Just $4)) }
+        | '{-# NOVECTORISE' qvar '#-}'                         { unitOL $ LL $ VectD (HsNoVect $2) }
+        | annotation { unitOL $1 }
+        | decl                                  { unLoc $1 }
+
+        -- Template Haskell Extension
+        -- The $(..) form is one possible form of infixexp
+        -- but we treat an arbitrary expression just as if 
+        -- it had a $(..) wrapped around it
+        | infixexp                              { unitOL (LL $ mkTopSpliceDecl $1) } 
 
 -- Type classes
 --
index 54dc378..6b8e5c0 100644 (file)
@@ -666,6 +666,10 @@ rnHsVectDecl (HsVect var (Just rhs))
        ; (rhs', fv_rhs) <- rnLExpr rhs
        ; return (HsVect var' (Just rhs'), fv_rhs `addOneFV` unLoc var')
        }
+rnHsVectDecl (HsNoVect var)
+  = do { var' <- wrapLocM lookupTopBndrRn var
+       ; return (HsNoVect var', unitFV (unLoc var'))
+       }
 \end{code}
 
 %*********************************************************
index 23a2472..59aba4b 100644 (file)
@@ -29,7 +29,7 @@ import FloatIn                ( floatInwards )
 import FloatOut                ( floatOutwards )
 import FamInstEnv
 import Id
-import BasicTypes       ( CompilerPhase, isDefaultInlinePragma )
+import BasicTypes
 import VarSet
 import VarEnv
 import LiberateCase    ( liberateCase )
@@ -356,11 +356,18 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
       -- space usage, especially with -O.  JRS, 000620.
       | let sz = coreBindsSize binds in sz == sz
       = do {
-               -- Occurrence analysis
-          let { tagged_binds = {-# SCC "OccAnal" #-} 
-                     occurAnalysePgm active_rule rules [] binds } ;
-          Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
-                    (pprCoreBindings tagged_binds);
+                -- Occurrence analysis
+           let {   -- During the 'InitialPhase' (i.e., before vectorisation), we need to make sure
+                   -- that the right-hand sides of vectorisation declarations are taken into 
+                   -- account during occurence analysis.
+                 maybeVects   = case sm_phase mode of
+                                  InitialPhase -> mg_vect_decls guts
+                                  _            -> []
+               ; tagged_binds = {-# SCC "OccAnal" #-} 
+                     occurAnalysePgm active_rule rules maybeVects binds 
+               } ;
+           Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
+                     (pprCoreBindings tagged_binds);
 
                -- Get any new rules, and extend the rule base
                -- See Note [Overall plumbing for rules] in Rules.lhs
index 881c304..b5bbeb1 100644 (file)
@@ -559,22 +559,29 @@ tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
 tcImpPrags prags
   = do { this_mod <- getModule
        ; dflags <- getDOpts
-       ; if not (dopt Opt_Specialise dflags) then
-            return []    -- Ignore SPECIALISE pragmas for imported things
-                        -- when -O is not on; otherwise we get bogus 
-                        -- complaints about lack of INLINABLE pragmas 
-                        -- in the imported module (also compiled without -O)
-                        -- Notably, when Haddocking the base library
+       ; if (not_specialising dflags) then
+            return []
          else
             mapAndRecoverM (wrapLocM tcImpSpec) 
             [L loc (name,prag) | (L loc prag@(SpecSig (L _ name) _ _)) <- prags
                                , not (nameIsLocalOrFrom this_mod name) ] }
+  where
+    -- Ignore SPECIALISE pragmas for imported things
+    -- when we aren't specialising, or when we aren't generating
+    -- code.  The latter happens when Haddocking the base library;
+    -- we don't wnat complaints about lack of INLINABLE pragmas 
+    not_specialising dflags
+      | not (dopt Opt_Specialise dflags) = True
+      | otherwise = case hscTarget dflags of
+                      HscNothing -> True
+                      HscInterpreted -> True
+                      _other         -> False
 
 tcImpSpec :: (Name, Sig Name) -> TcM TcSpecPrag
 tcImpSpec (name, prag)
  = do { id <- tcLookupId name
-      ; checkTc (isAnyInlinePragma (idInlinePragma id))
-                (impSpecErr name)
+      ; unless (isAnyInlinePragma (idInlinePragma id))
+               (addWarnTc (impSpecErr name))
       ; tcSpec id prag }
 
 impSpecErr :: Name -> SDoc
@@ -591,7 +598,7 @@ impSpecErr name
 tcVectDecls :: [LVectDecl Name] -> TcM ([LVectDecl TcId])
 tcVectDecls decls 
   = do { decls' <- mapM (wrapLocM tcVect) decls
-       ; let ids  = [unLoc id | L _ (HsVect id _) <- decls']
+       ; let ids  = map lvectDeclName decls'
              dups = findDupsEq (==) ids
        ; mapM_ reportVectDups dups
        ; traceTcConstraints "End of tcVectDecls"
@@ -642,6 +649,11 @@ tcVect (HsVect name@(L loc _) (Just rhs))
         -- to the vectoriser - see "Note [Typechecked vectorisation pragmas]" in HsDecls
        ; return $ HsVect (L loc id') (Just rhsWrapped)
        }
+tcVect (HsNoVect name)
+  = addErrCtxt (vectCtxt name) $
+    do { id <- wrapLocM tcLookupId name
+       ; return $ HsNoVect id
+       }
 
 vectCtxt :: Located Name -> SDoc
 vectCtxt name = ptext (sLit "When checking the vectorisation declaration for") <+> ppr name
index 12b50ac..3b4afae 100644 (file)
@@ -1027,6 +1027,10 @@ zonkVect env (HsVect v (Just e))
        ; e' <- zonkLExpr env e
        ; return $ HsVect v' (Just e')
        }
+zonkVect env (HsNoVect v)
+  = do { v' <- wrapLocM (zonkIdBndr env) v
+       ; return $ HsNoVect v'
+       }
 \end{code}
 
 %************************************************************************
index 4994e3f..35ddd9d 100644 (file)
@@ -1,4 +1,3 @@
-{-# OPTIONS -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
 
 module Vectorise ( vectorise )
 where
@@ -82,98 +81,124 @@ vectModule guts@(ModGuts { mg_types     = types
                       }
       }
 
--- | Try to vectorise a top-level binding.
---   If it doesn't vectorise then return it unharmed.
+-- |Try to vectorise a top-level binding.  If it doesn't vectorise then return it unharmed.
 --
---   For example, for the binding 
+-- For example, for the binding 
 --
---   @  
---      foo :: Int -> Int
---      foo = \x -> x + x
---   @
---  
---   we get
---   @
---      foo  :: Int -> Int
---      foo  = \x -> vfoo $: x                  
--- 
---      v_foo :: Closure void vfoo lfoo
---      v_foo = closure vfoo lfoo void        
--- 
---      vfoo :: Void -> Int -> Int
---      vfoo = ...
+-- @  
+--    foo :: Int -> Int
+--    foo = \x -> x + x
+-- @
 --
---      lfoo :: PData Void -> PData Int -> PData Int
---      lfoo = ...
---   @ 
+-- we get
+-- @
+--    foo  :: Int -> Int
+--    foo  = \x -> vfoo $: x                  
 --
---   @vfoo@ is the "vectorised", or scalar, version that does the same as the original
---   function foo, but takes an explicit environment.
--- 
---   @lfoo@ is the "lifted" version that works on arrays.
+--    v_foo :: Closure void vfoo lfoo
+--    v_foo = closure vfoo lfoo void        
+--
+--    vfoo :: Void -> Int -> Int
+--    vfoo = ...
+--
+--    lfoo :: PData Void -> PData Int -> PData Int
+--    lfoo = ...
+-- @ 
 --
---   @v_foo@ combines both of these into a `Closure` that also contains the
---   environment.
+-- @vfoo@ is the "vectorised", or scalar, version that does the same as the original
+-- function foo, but takes an explicit environment.
 --
---   The original binding @foo@ is rewritten to call the vectorised version
---   present in the closure.
+-- @lfoo@ is the "lifted" version that works on arrays.
+--
+-- @v_foo@ combines both of these into a `Closure` that also contains the
+-- environment.
+--
+-- The original binding @foo@ is rewritten to call the vectorised version
+-- present in the closure.
+--
+-- Vectorisation may be surpressed by annotating a binding with a 'NOVECTORISE' pragma.  If this
+-- pragma is used in a group of mutually recursive bindings, either all or no binding must have
+-- the pragma.  If only some bindings are annotated, a fatal error is being raised.
+-- FIXME: Once we support partial vectorisation, we may be able to vectorise parts of a group, or
+--   we may emit a warning and refrain from vectorising the entire group.
 --
 vectTopBind :: CoreBind -> VM CoreBind
 vectTopBind b@(NonRec var expr)
- = do {   -- Vectorise the right-hand side, create an appropriate top-level binding and add it to
-          -- the vectorisation map.
-      ; (inline, isScalar, expr') <- vectTopRhs [] var expr
-      ; var' <- vectTopBinder var inline expr'
-      ; when isScalar $ 
-          addGlobalScalar var
-
-          -- We replace the original top-level binding by a value projected from the vectorised
-          -- closure and add any newly created hoisted top-level bindings.
-      ; cexpr <- tryConvert var var' expr
-      ; hs <- takeHoisted
-      ; return . Rec $ (var, cexpr) : (var', expr') : hs
-      }
-  `orElseV`
-    return b
+  = unlessNoVectDecl $
+      do {   -- Vectorise the right-hand side, create an appropriate top-level binding and add it
+             -- to the vectorisation map.
+         ; (inline, isScalar, expr') <- vectTopRhs [] var expr
+         ; var' <- vectTopBinder var inline expr'
+         ; when isScalar $ 
+             addGlobalScalar var
+             -- We replace the original top-level binding by a value projected from the vectorised
+             -- closure and add any newly created hoisted top-level bindings.
+         ; cexpr <- tryConvert var var' expr
+         ; hs <- takeHoisted
+         ; return . Rec $ (var, cexpr) : (var', expr') : hs
+         }
+     `orElseV`
+       return b
+  where
+    unlessNoVectDecl vectorise
+      = do { hasNoVectDecl <- noVectDecl var
+           ; when hasNoVectDecl $
+               traceVt "NOVECTORISE" $ ppr var
+           ; if hasNoVectDecl then return b else vectorise
+           }
 vectTopBind b@(Rec bs)
- = let (vars, exprs) = unzip bs
-   in
-   do { (vars', _, exprs', hs) <- fixV $ 
-          \ ~(_, inlines, rhss, _) ->
-            do {   -- Vectorise the right-hand sides, create an appropriate top-level bindings and
-                   --  add them to the vectorisation map.
-               ; vars' <- sequence [vectTopBinder var inline rhs
-                                   | (var, ~(inline, rhs)) <- zipLazy vars (zip inlines rhss)]
-               ; (inlines, areScalars, exprs') <- mapAndUnzip3M (uncurry $ vectTopRhs vars) bs
-               ; hs <- takeHoisted
-               ; if and areScalars
-                 then      -- (1) Entire recursive group is scalar
-                           --      => add all variables to the global set of scalars
-                      do { mapM addGlobalScalar vars
-                         ; return (vars', inlines, exprs', hs)
-                         }
-                 else      -- (2) At least one binding is not scalar
-                           --     => vectorise again with empty set of local scalars
-                      do { (inlines, _, exprs') <- mapAndUnzip3M (uncurry $ vectTopRhs []) bs
-                         ; hs <- takeHoisted
-                         ; return (vars', inlines, exprs', hs)
-                         }
-               }
-                      
-          -- Replace the original top-level bindings by a values projected from the vectorised
-          -- closures and add any newly created hoisted top-level bindings to the group.
-      ; cexprs <- sequence $ zipWith3 tryConvert vars vars' exprs
-      ; return . Rec $ zip vars cexprs ++ zip vars' exprs' ++ hs
-      }
-  `orElseV`
-    return b    
-    
+  = unlessSomeNoVectDecl $
+      do { (vars', _, exprs', hs) <- fixV $ 
+             \ ~(_, inlines, rhss, _) ->
+               do {   -- Vectorise the right-hand sides, create an appropriate top-level bindings
+                      -- and add them to the vectorisation map.
+                  ; vars' <- sequence [vectTopBinder var inline rhs
+                                      | (var, ~(inline, rhs)) <- zipLazy vars (zip inlines rhss)]
+                  ; (inlines, areScalars, exprs') <- mapAndUnzip3M (uncurry $ vectTopRhs vars) bs
+                  ; hs <- takeHoisted
+                  ; if and areScalars
+                    then      -- (1) Entire recursive group is scalar
+                              --      => add all variables to the global set of scalars
+                         do { mapM_ addGlobalScalar vars
+                            ; return (vars', inlines, exprs', hs)
+                            }
+                    else      -- (2) At least one binding is not scalar
+                              --     => vectorise again with empty set of local scalars
+                         do { (inlines, _, exprs') <- mapAndUnzip3M (uncurry $ vectTopRhs []) bs
+                            ; hs <- takeHoisted
+                            ; return (vars', inlines, exprs', hs)
+                            }
+                  }
+                       
+             -- Replace the original top-level bindings by a values projected from the vectorised
+             -- closures and add any newly created hoisted top-level bindings to the group.
+         ; cexprs <- sequence $ zipWith3 tryConvert vars vars' exprs
+         ; return . Rec $ zip vars cexprs ++ zip vars' exprs' ++ hs
+         }
+     `orElseV`
+       return b    
+  where
+    (vars, exprs) = unzip bs
+
+    unlessSomeNoVectDecl vectorise
+      = do { hasNoVectDecls <- mapM noVectDecl vars
+           ; when (and hasNoVectDecls) $
+               traceVt "NOVECTORISE" $ ppr vars
+           ; if and hasNoVectDecls 
+             then return b                              -- all bindings have 'NOVECTORISE'
+             else if or hasNoVectDecls 
+             then cantVectorise noVectoriseErr (ppr b)  -- some (but not all) have 'NOVECTORISE'
+             else vectorise                             -- no binding has a 'NOVECTORISE' decl
+           }
+    noVectoriseErr = "NOVECTORISE must be used on all or no bindings of a recursive group"
+     
 -- | Make the vectorised version of this top level binder, and add the mapping
 --   between it and the original to the state. For some binder @foo@ the vectorised
 --   version is @$v_foo@
 --
---   NOTE: vectTopBinder *MUST* be lazy in inline and expr because of how it is
---   used inside of fixV in vectTopBind
+--   NOTE: 'vectTopBinder' *MUST* be lazy in inline and expr because of how it is
+--   used inside of 'fixV' in 'vectTopBind'.
 --
 vectTopBinder :: Var      -- ^ Name of the binding.
               -> Inline   -- ^ Whether it should be inlined, used to annotate it.
index 51b3d14..a59f936 100644 (file)
@@ -27,7 +27,7 @@ preludeVars :: Modules
 preludeVars (Modules { dph_Combinators    = _dph_Combinators
                      , dph_Prelude_Int    = dph_Prelude_Int
                      , dph_Prelude_Word8  = dph_Prelude_Word8
-                     , dph_Prelude_Double = dph_Prelude_Double
+                     -- , dph_Prelude_Double = dph_Prelude_Double
                      , dph_Prelude_Bool   = dph_Prelude_Bool 
                      })
 
@@ -50,11 +50,11 @@ preludeVars (Modules { dph_Combinators    = _dph_Combinators
     , mk' dph_Prelude_Word8 "toInt"   "toIntV"
     ]
 
-    ++ vars_Ord        dph_Prelude_Double
-    ++ vars_Num        dph_Prelude_Double
-    ++ vars_Fractional dph_Prelude_Double
-    ++ vars_Floating   dph_Prelude_Double
-    ++ vars_RealFrac   dph_Prelude_Double
+    -- ++ vars_Ord        dph_Prelude_Double
+    -- ++ vars_Num        dph_Prelude_Double
+    -- ++ vars_Fractional dph_Prelude_Double
+    -- ++ vars_Floating   dph_Prelude_Double
+    -- ++ vars_RealFrac   dph_Prelude_Double
     ++
     [ mk dph_Prelude_Bool  (fsLit "andP")  dph_Prelude_Bool (fsLit "andPA")
     , mk dph_Prelude_Bool  (fsLit "orP")   dph_Prelude_Bool (fsLit "orPA")
@@ -92,40 +92,40 @@ preludeVars (Modules { dph_Combinators    = _dph_Combinators
        , mk' mod "productP" "productPA"
        ]
 
-    vars_Fractional mod 
-     = [ mk' mod "/"     "divideV"
-       , mk' mod "recip" "recipV"
-       ]
-
-    vars_Floating mod 
-     = [ mk' mod "pi"      "pi"
-       , mk' mod "exp"     "expV"
-       , mk' mod "sqrt"    "sqrtV"
-       , mk' mod "log"     "logV"
-       , mk' mod "sin"     "sinV"
-       , mk' mod "tan"     "tanV"
-       , mk' mod "cos"     "cosV"
-       , mk' mod "asin"    "asinV"
-       , mk' mod "atan"    "atanV"
-       , mk' mod "acos"    "acosV"
-       , mk' mod "sinh"    "sinhV"
-       , mk' mod "tanh"    "tanhV"
-       , mk' mod "cosh"    "coshV"
-       , mk' mod "asinh"   "asinhV"
-       , mk' mod "atanh"   "atanhV"
-       , mk' mod "acosh"   "acoshV"
-       , mk' mod "**"      "powV"
-       , mk' mod "logBase" "logBaseV"
-       ]
-
-    vars_RealFrac mod
-     = [ mk' mod "fromInt"  "fromIntV"
-       , mk' mod "truncate" "truncateV"
-       , mk' mod "round"    "roundV"
-       , mk' mod "ceiling"  "ceilingV"
-       , mk' mod "floor"    "floorV"
-       ]
-
+    -- vars_Fractional mod 
+    --  = [ mk' mod "/"     "divideV"
+    --    , mk' mod "recip" "recipV"
+    --    ]
+    -- 
+    -- vars_Floating mod 
+    --  = [ mk' mod "pi"      "pi"
+    --    , mk' mod "exp"     "expV"
+    --    , mk' mod "sqrt"    "sqrtV"
+    --    , mk' mod "log"     "logV"
+    --    , mk' mod "sin"     "sinV"
+    --    , mk' mod "tan"     "tanV"
+    --    , mk' mod "cos"     "cosV"
+    --    , mk' mod "asin"    "asinV"
+    --    , mk' mod "atan"    "atanV"
+    --    , mk' mod "acos"    "acosV"
+    --    , mk' mod "sinh"    "sinhV"
+    --    , mk' mod "tanh"    "tanhV"
+    --    , mk' mod "cosh"    "coshV"
+    --    , mk' mod "asinh"   "asinhV"
+    --    , mk' mod "atanh"   "atanhV"
+    --    , mk' mod "acosh"   "acoshV"
+    --    , mk' mod "**"      "powV"
+    --    , mk' mod "logBase" "logBaseV"
+    --    ]
+    -- 
+    -- vars_RealFrac mod
+    --  = [ mk' mod "fromInt"  "fromIntV"
+    --    , mk' mod "truncate" "truncateV"
+    --    , mk' mod "round"    "roundV"
+    --    , mk' mod "ceiling"  "ceilingV"
+    --    , mk' mod "floor"    "floorV"
+    --    ]
+    -- 
 preludeScalars :: Modules -> [(Module, FastString)]
 preludeScalars (Modules { dph_Prelude_Int    = dph_Prelude_Int
                         , dph_Prelude_Word8  = dph_Prelude_Word8
index 780a07f..97bb5ae 100644 (file)
@@ -95,6 +95,10 @@ data GlobalEnv
         , global_scalar_tycons  :: NameSet
           -- ^Type constructors whose values can only contain scalar data.  Scalar code may only
           -- operate on such data.
+        
+        , global_novect_vars    :: VarSet
+          -- ^Variables that are not vectorised.  (They may be referenced in the right-hand sides
+          -- of vectorisation declarations, though.)
 
         , global_exported_vars  :: VarEnv (Var, Var)
           -- ^Exported variables which have a vectorised version.
@@ -134,6 +138,7 @@ initGlobalEnv info vectDecls instEnvs famInstEnvs
   , global_vect_decls    = mkVarEnv vects
   , global_scalar_vars   = vectInfoScalarVars   info `extendVarSetList` scalars
   , global_scalar_tycons = vectInfoScalarTyCons info
+  , global_novect_vars   = mkVarSet novects
   , global_exported_vars = emptyVarEnv
   , global_tycons        = mapNameEnv snd $ vectInfoTyCon info
   , global_datacons      = mapNameEnv snd $ vectInfoDataCon info
@@ -147,6 +152,7 @@ initGlobalEnv info vectDecls instEnvs famInstEnvs
   where
     vects   = [(var, (varType var, exp)) | Vect var (Just exp) <- vectDecls]
     scalars = [var                       | Vect var Nothing    <- vectDecls]
+    novects = [var                       | NoVect var          <- vectDecls]
 
 
 -- Operators on Global Environments -------------------------------------------
index e2933cd..73cba88 100644 (file)
@@ -81,6 +81,7 @@ initV hsc_env guts info thing_inside
            ; builtin_pas <- initBuiltinPAs builtins instEnvs
 
                -- construct the initial global environment
+           ; let thing_inside' = traceVt "VectDecls" (ppr (mg_vect_decls guts)) >> thing_inside
            ; let genv = extendImportedVarsEnv builtin_vars
                         . extendScalars       builtin_scalars
                         . extendTyConsEnv     builtin_tycons
@@ -91,7 +92,7 @@ initV hsc_env guts info thing_inside
                         $ initGlobalEnv info (mg_vect_decls guts) instEnvs famInstEnvs
  
                -- perform vectorisation
-           ; r <- runVM thing_inside builtins genv emptyLocalEnv
+           ; r <- runVM thing_inside' builtins genv emptyLocalEnv
            ; case r of
                Yes genv _ x -> return $ Just (new_info genv, x)
                No           -> return Nothing
index 632845f..e471ebb 100644 (file)
@@ -1,34 +1,34 @@
 
 module Vectorise.Monad.Global (
-       readGEnv,
-       setGEnv,
-       updGEnv,
-       
+  readGEnv,
+  setGEnv,
+  updGEnv,
+  
   -- * Vars
   defGlobalVar,
   
   -- * Vectorisation declarations
-  lookupVectDecl,
+  lookupVectDecl, noVectDecl, 
   
   -- * Scalars
   globalScalars, isGlobalScalar,
-       
-       -- * TyCons
-       lookupTyCon,
-       lookupBoxedTyCon,
-       defTyCon,
-       
-       -- * Datacons
-       lookupDataCon,
-       defDataCon,
-       
-       -- * PA Dictionaries
-       lookupTyConPA,
-       defTyConPA,
-       defTyConPAs,
-       
-       -- * PR Dictionaries
-       lookupTyConPR
+  
+  -- * TyCons
+  lookupTyCon,
+  lookupBoxedTyCon,
+  defTyCon,
+  
+  -- * Datacons
+  lookupDataCon,
+  defDataCon,
+  
+  -- * PA Dictionaries
+  lookupTyConPA,
+  defTyConPA,
+  defTyConPAs,
+  
+  -- * PR Dictionaries
+  lookupTyConPR
 ) where
 
 import Vectorise.Monad.Base
@@ -45,23 +45,27 @@ import VarSet
 
 
 -- Global Environment ---------------------------------------------------------
--- | Project something from the global environment.
+
+-- |Project something from the global environment.
+--
 readGEnv :: (GlobalEnv -> a) -> VM a
 readGEnv f     = VM $ \_ genv lenv -> return (Yes genv lenv (f genv))
 
-
--- | Set the value of the global environment.
+-- |Set the value of the global environment.
+--
 setGEnv :: GlobalEnv -> VM ()
 setGEnv genv   = VM $ \_ _ lenv -> return (Yes genv lenv ())
 
-
--- | Update the global environment using the provided function.
+-- |Update the global environment using the provided function.
+--
 updGEnv :: (GlobalEnv -> GlobalEnv) -> VM ()
 updGEnv f      = VM $ \_ genv lenv -> return (Yes (f genv) lenv ())
 
 
 -- Vars -----------------------------------------------------------------------
--- | Add a mapping between a global var and its vectorised version to the state.
+
+-- |Add a mapping between a global var and its vectorised version to the state.
+--
 defGlobalVar :: Var -> Var -> VM ()
 defGlobalVar v v' = updGEnv $ \env ->
   env { global_vars = extendVarEnv (global_vars env) v v'
@@ -79,6 +83,11 @@ defGlobalVar v v' = updGEnv $ \env ->
 lookupVectDecl :: Var -> VM (Maybe (Type, CoreExpr))
 lookupVectDecl var = readGEnv $ \env -> lookupVarEnv (global_vect_decls env) var
 
+-- |Check whether a variable has a 'NOVECTORISE' declaration.
+--
+noVectDecl :: Var -> VM Bool
+noVectDecl var = readGEnv $ \env -> elemVarSet var (global_novect_vars env)
+
 
 -- Scalars --------------------------------------------------------------------
 
@@ -94,7 +103,9 @@ isGlobalScalar var = readGEnv $ \env -> elemVarSet var (global_scalar_vars env)
 
 
 -- TyCons ---------------------------------------------------------------------
--- | Lookup the vectorised version of a `TyCon` from the global environment.
+
+-- |Lookup the vectorised version of a `TyCon` from the global environment.
+--
 lookupTyCon :: TyCon -> VM (Maybe TyCon)
 lookupTyCon tc
   | isUnLiftedTyCon tc || isTupleTyCon tc
@@ -103,14 +114,12 @@ lookupTyCon tc
   | otherwise 
   = readGEnv $ \env -> lookupNameEnv (global_tycons env) (tyConName tc)
 
-
 -- | Lookup the vectorised version of a boxed `TyCon` from the global environment.
 lookupBoxedTyCon :: TyCon -> VM (Maybe TyCon)
 lookupBoxedTyCon tc 
        = readGEnv $ \env -> lookupNameEnv (global_boxed_tycons env)
                                            (tyConName tc)
 
-
 -- | Add a mapping between plain and vectorised `TyCon`s to the global environment.
 defTyCon :: TyCon -> TyCon -> VM ()
 defTyCon tc tc' = updGEnv $ \env ->
@@ -118,6 +127,7 @@ defTyCon tc tc' = updGEnv $ \env ->
 
 
 -- DataCons -------------------------------------------------------------------
+
 -- | Lookup the vectorised version of a `DataCon` from the global environment.
 lookupDataCon :: DataCon -> VM (Maybe DataCon)
 lookupDataCon dc
index d4a7cbe..18e60e7 100644 (file)
@@ -120,8 +120,8 @@ SharedLibsPlatformList = i386-unknown-linux x86_64-unknown-linux \
        i386-unknown-mingw32 \
        i386-apple-darwin powerpc-apple-darwin
 
-ifeq ($(SOLARIS_BROKEN_SHLD), NO)
-SharedLibsPlatformList := $(SharedLibsPlatformList) i386-unknown-solaris2
+ifeq "$(SOLARIS_BROKEN_SHLD)" "NO"
+SharedLibsPlatformList += i386-unknown-solaris2
 endif
 
 PlatformSupportsSharedLibs = $(if $(filter $(TARGETPLATFORM),\
index b7f788b..e250fa6 100644 (file)
@@ -23,7 +23,7 @@ STRIP_CMD       = :
 CHECK_PACKAGES = YES
 
 # We want to install DPH when validating, so that we can test it
-InstallExtraPackages = YES    
+InstallExtraPackages = YES
 
 # dblatex with miktex under msys/mingw can't build the PS and PDF docs,
 # and just building the HTML docs is sufficient to check that the
index 9720329..923b620 100644 (file)
--- a/packages
+++ b/packages
@@ -1,5 +1,8 @@
 # Despite the name "package", this file contains the master list of 
-# the *repositories* that make up GHC. It is parsed by boot and darcs-all.
+# the *repositories* that make up GHC. It is parsed by
+# * boot
+# * sync-all
+# * rules/extra-packages.mk
 #
 # Some of this information is duplicated elsewhere in the build system:
 #    See Trac #3896
@@ -17,7 +20,7 @@
 #    - nofib and testsuite are optional helpers
 #
 # The format of the lines in this file is:
-#   localpath    tag    remotepath    VCS    upstream
+#   localpath    tag    remotepath    VCS
 # where
 #   * 'localpath' is where to put the repository in a checked out tree.
 #   * 'remotepath' is where the repository is in the central repository.
 #     deems to have the EXTRA_PACKAGE property: tags 'dph' and 'extra' 
 #     both give this property
 #
-#   * 'upstream' is the URL of the upstream repo, where there is one, or
-#     "-" if there is no upstream.
-#
 # Lines that start with a '#' are comments.
-.                               -           ghc.git                             git   -
-ghc-tarballs                    -           ghc-tarballs.git                    git   -
-utils/hsc2hs                    -           hsc2hs.git                          git   -
-# haddock does have an upstream:
-#   http://code.haskell.org/haddock/
-# but it stays buildable with the last stable release rather than tracking HEAD,
-# and is resynced with the GHC HEAD branch by David Waern when appropriate
-utils/haddock                   -           haddock2.git                        git   -
-libraries/array                 -           packages/array.git                  git   -
-libraries/base                  -           packages/base.git                   git   -
-libraries/binary                -           packages/binary.git                 git   http://code.haskell.org/binary/
-libraries/bytestring            -           packages/bytestring.git             git   http://darcs.haskell.org/bytestring/
-libraries/Cabal                 -           packages/Cabal.git                  git   http://darcs.haskell.org/cabal/
-libraries/containers            -           packages/containers.git             git   -
-libraries/directory             -           packages/directory.git              git   -
-libraries/extensible-exceptions -           packages/extensible-exceptions.git  git   -
-libraries/filepath              -           packages/filepath.git               git   -
-libraries/ghc-prim              -           packages/ghc-prim.git               git   -
-libraries/haskeline             -           packages/haskeline.git              git   http://code.haskell.org/haskeline/
-libraries/haskell98             -           packages/haskell98.git              git   -
-libraries/haskell2010           -           packages/haskell2010.git            git   -
-libraries/hoopl                 -           packages/hoopl.git                  git   -
-libraries/hpc                   -           packages/hpc.git                    git   -
-libraries/integer-gmp           -           packages/integer-gmp.git            git   -
-libraries/integer-simple        -           packages/integer-simple.git         git   -
-libraries/mtl                   -           packages/mtl.git                    git   -
-libraries/old-locale            -           packages/old-locale.git             git   -
-libraries/old-time              -           packages/old-time.git               git   -
-libraries/pretty                -           packages/pretty.git                 git   -
-libraries/process               -           packages/process.git                git   -
-libraries/random                -           packages/random.git                 git   -
-libraries/template-haskell      -           packages/template-haskell.git       git   -
-libraries/terminfo              -           packages/terminfo.git               git   http://code.haskell.org/terminfo/
-libraries/unix                  -           packages/unix.git                   git   -
-libraries/utf8-string           -           packages/utf8-string.git            git   http://code.haskell.org/utf8-string/
-libraries/Win32                 -           packages/Win32.git                  git   -
-libraries/xhtml                 -           packages/xhtml.git                  git   -
-testsuite                       testsuite   testsuite.git                       git   -
-nofib                           nofib       nofib.git                           git   -
-libraries/deepseq               extra       packages/deepseq.git                git   -
-libraries/parallel              extra       packages/parallel.git               git   -
-libraries/stm                   extra       packages/stm.git                    git   -
-libraries/primitive             dph         packages/primitive.git              git   http://code.haskell.org/primitive
-libraries/vector                dph         packages/vector.git                 git   http://code.haskell.org/vector
-libraries/dph                   dph         packages/dph.git                    git   -
+.                               -           ghc.git                             git
+ghc-tarballs                    -           ghc-tarballs.git                    git
+utils/hsc2hs                    -           hsc2hs.git                          git
+utils/haddock                   -           haddock2.git                        git
+libraries/array                 -           packages/array.git                  git
+libraries/base                  -           packages/base.git                   git
+libraries/binary                -           packages/binary.git                 git
+libraries/bytestring            -           packages/bytestring.git             git
+libraries/Cabal                 -           packages/Cabal.git                  git
+libraries/containers            -           packages/containers.git             git
+libraries/directory             -           packages/directory.git              git
+libraries/extensible-exceptions -           packages/extensible-exceptions.git  git
+libraries/filepath              -           packages/filepath.git               git
+libraries/ghc-prim              -           packages/ghc-prim.git               git
+libraries/haskeline             -           packages/haskeline.git              git
+libraries/haskell98             -           packages/haskell98.git              git
+libraries/haskell2010           -           packages/haskell2010.git            git
+libraries/hoopl                 -           packages/hoopl.git                  git
+libraries/hpc                   -           packages/hpc.git                    git
+libraries/integer-gmp           -           packages/integer-gmp.git            git
+libraries/integer-simple        -           packages/integer-simple.git         git
+libraries/mtl                   -           packages/mtl.git                    git
+libraries/old-locale            -           packages/old-locale.git             git
+libraries/old-time              -           packages/old-time.git               git
+libraries/pretty                -           packages/pretty.git                 git
+libraries/process               -           packages/process.git                git
+libraries/random                -           packages/random.git                 git
+libraries/template-haskell      -           packages/template-haskell.git       git
+libraries/terminfo              -           packages/terminfo.git               git
+libraries/unix                  -           packages/unix.git                   git
+libraries/utf8-string           -           packages/utf8-string.git            git
+libraries/Win32                 -           packages/Win32.git                  git
+libraries/xhtml                 -           packages/xhtml.git                  git
+testsuite                       testsuite   testsuite.git                       git
+nofib                           nofib       nofib.git                           git
+libraries/deepseq               extra       packages/deepseq.git                git
+libraries/parallel              extra       packages/parallel.git               git
+libraries/stm                   extra       packages/stm.git                    git
+libraries/primitive             dph         packages/primitive.git              git
+libraries/vector                dph         packages/vector.git                 git
+libraries/dph                   dph         packages/dph.git                    git
index 1cef9ad..e3af94f 100644 (file)
@@ -27,7 +27,7 @@
 #        add P to the list of packages
 
 define extra-packages
-$$(foreach p,$$(patsubst libraries/%,%,$$(wildcard $$(shell grep '^[^ #][^ ]* \+\(dph\|extra\) \+[^ ]\+ \+[^ ]\+ \+[^ ]\+' packages | sed 's/ .*//'))),\
+$$(foreach p,$$(patsubst libraries/%,%,$$(wildcard $$(shell grep '^[^ #][^ ]* \+\(dph\|extra\) \+[^ ]\+ \+[^ ]\+$$$$' packages | sed 's/ .*//'))),\
     $$(if $$(wildcard libraries/$$p/ghc-packages),\
         $$(eval BUILD_DIRS += libraries/$$p) \
         $$(foreach q,$$(shell cat libraries/$$p/ghc-packages2),$$(eval $$(call extra-package,$$p,$$p/$$q))),\
index 8b41c97..ac06af1 100755 (executable)
--- a/sync-all
+++ b/sync-all
@@ -142,13 +142,12 @@ sub parsePackages {
     foreach (@repos) {
         chomp;
         $lineNum++;
-        if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
+        if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
             my %line;
             $line{"localpath"}  = $1;
             $line{"tag"}        = $2;
             $line{"remotepath"} = $3;
             $line{"vcs"}        = $4;
-            $line{"upstream"}   = $5;
             push @packages, \%line;
         }
         elsif (! /^(#.*)?$/) {
@@ -198,7 +197,6 @@ sub scmall {
     my $tag;
     my $remotepath;
     my $scm;
-    my $upstream;
     my $line;
     my $branch_name;
     my $subcommand;
@@ -252,7 +250,6 @@ sub scmall {
         $tag        = $$line{"tag"};
         $remotepath = $$line{"remotepath"};
         $scm        = $$line{"vcs"};
-        $upstream   = $$line{"upstream"};
 
         # Check the SCM is OK as early as possible
         die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));