Last state on cam-05 HEADwip/spj-cam-HEADwip/T14137

13 files changed, 701 insertions, 53 deletions

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index adb399ea6f..e133e0b425 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -21,7 +21,7 @@ module CoreUnfold (
         Unfolding, UnfoldingGuidance,   -- Abstract types
 
         noUnfolding, mkImplicitUnfolding,
-        mkUnfolding, mkCoreUnfolding,
+        mkUnfolding, mkJoinUnfolding, mkCoreUnfolding,
         mkTopUnfolding, mkSimpleUnfolding, mkWorkerUnfolding,
         mkInlineUnfolding, mkInlineUnfoldingWithArity,
         mkInlinableUnfolding, mkWwInlineRule,
@@ -345,6 +345,24 @@ mkUnfolding dflags src is_top_lvl is_bottoming expr
         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
 
+mkJoinUnfolding :: DynFlags
+            -> CoreExpr
+            -> Unfolding
+-- Calculates unfolding guidance
+-- Occurrence-analyses the expression before capturing it
+mkJoinUnfolding dflags expr
+  = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
+                      -- See Note [Occurrence analysis of unfoldings]
+                    uf_src          = InlineRhs,
+                    uf_is_top       = False,
+                    uf_is_value     = exprIsHNF        expr,
+                    uf_is_conlike   = exprIsConLike    expr,
+                    uf_expandable   = exprIsExpandable expr,
+                    uf_is_work_free = True, -- See Note [Unfoldings for join points]
+                    uf_guidance     = guidance }
+  where
+    guidance = calcUnfoldingGuidance dflags False expr
+
 {-
 Note [Occurrence analysis of unfoldings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -425,6 +443,7 @@ calcUnfoldingGuidance
 calcUnfoldingGuidance dflags is_top_bottoming (Tick t expr)
   | not (tickishIsCode t)  -- non-code ticks don't matter for unfolding
   = calcUnfoldingGuidance dflags is_top_bottoming expr
+
 calcUnfoldingGuidance dflags is_top_bottoming expr
   = case sizeExpr dflags bOMB_OUT_SIZE val_bndrs body of
       TooBig -> UnfNever
@@ -1077,8 +1096,11 @@ couldBeSmallEnoughToInline dflags threshold rhs
 
 ----------------
 smallEnoughToInline :: DynFlags -> Unfolding -> Bool
-smallEnoughToInline dflags (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}})
-  = size <= ufUseThreshold dflags
+smallEnoughToInline dflags (CoreUnfolding {uf_guidance = guidance})
+  = case guidance of
+      UnfIfGoodArgs {ug_size = size} -> size <= ufUseThreshold dflags
+      UnfWhen {}                     -> True
+      UnfNever {}                    -> False
 smallEnoughToInline _ _
   = False
 
@@ -1267,15 +1289,22 @@ tryUnfolding dflags id lone_variable
      UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
         | ufVeryAggressive dflags
         -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)
+
+--        | is_join && join_small_enough
+--        -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)
+
         | is_wf && some_benefit && small_enough
         -> traceInline dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)
+
         | otherwise
         -> traceInline dflags id str (mk_doc some_benefit extra_doc False) Nothing
         where
-          some_benefit = calc_some_benefit (length arg_discounts)
-          extra_doc = text "discounted size =" <+> int discounted_size
+          uf_arity        = length arg_discounts
+          some_benefit    = calc_some_benefit uf_arity
+          extra_doc       = text "discounted size =" <+> int discounted_size
           discounted_size = size - discount
-          small_enough = discounted_size <= ufUseThreshold dflags
+          use_threshold   = ufUseThreshold dflags
+          small_enough    = discounted_size <= use_threshold
           discount = computeDiscount dflags arg_discounts
                                      res_discount arg_infos cont_info
 
@@ -1292,6 +1321,7 @@ tryUnfolding dflags id lone_variable
 
     str = "Considering inlining: " ++ showSDocDump dflags (ppr id)
     n_val_args = length arg_infos
+    is_join    = isJoinId id
 
            -- some_benefit is used when the RHS is small enough
            -- and the call has enough (or too many) value
@@ -1313,18 +1343,20 @@ tryUnfolding dflags id lone_variable
                 -- over-saturated args too which is "wrong";
                 -- but if over-saturated we inline anyway.
 
+        work_safe = uf_arity > 0
         interesting_call
+          | is_join
+          = False
           | over_saturated
           = True
           | otherwise
           = case cont_info of
-              CaseCtxt   -> not (lone_variable && is_exp)  -- Note [Lone variables]
-              ValAppCtxt -> True                           -- Note [Cast then apply]
-              RuleArgCtxt -> uf_arity > 0  -- See Note [Unfold info lazy contexts]
-              DiscArgCtxt -> uf_arity > 0  -- Note [Inlining in ArgCtxt]
-              RhsCtxt     -> uf_arity > 0  --
-              _other      -> False         -- See Note [Nested functions]
-
+              CaseCtxt    -> not (lone_variable && is_exp)  -- Note [Lone variables]
+              ValAppCtxt  -> True                           -- Note [Cast then apply]
+              RuleArgCtxt -> work_safe  -- See Note [Unfold into lazy contexts]
+              DiscArgCtxt -> work_safe  -- See Note [Inlining in ArgCtxt]
+              RhsCtxt     -> work_safe  --
+              _           -> False      -- Note [Nested functions]
 
 {-
 Note [Unfold into lazy contexts], Note [RHS of lets]
diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs
index 2593b1d7a1..04e4d32f5e 100644
--- a/compiler/simplCore/FloatIn.hs
+++ b/compiler/simplCore/FloatIn.hs
@@ -26,8 +26,9 @@ import MkCore
 import HscTypes         ( ModGuts(..) )
 import CoreUtils
 import CoreFVs
+import CoreUnfold
 import CoreMonad        ( CoreM )
-import Id               ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
+import Id
 import Var
 import Type
 import VarSet
@@ -151,7 +152,7 @@ fiExpr dflags to_drop (_, AnnCast expr (co_ann, co))
     Cast (fiExpr dflags e_drop expr) co
   where
     [drop_here, e_drop, co_drop]
-      = sepBindsByDropPoint dflags False
+      = sepBindsByDropPoint dflags SepVanilla
           [freeVarsOf expr, freeVarsOfAnn co_ann]
           to_drop
 
@@ -173,7 +174,7 @@ fiExpr dflags to_drop ann_expr@(_,AnnApp {})
     arg_fvs = map freeVarsOf ann_args
 
     (drop_here : extra_drop : fun_drop : arg_drops)
-       = sepBindsByDropPoint dflags False
+       = sepBindsByDropPoint dflags SepVanilla
                              (extra_fvs : fun_fvs : arg_fvs)
                              to_drop
          -- Shortcut behaviour: if to_drop is empty,
@@ -446,7 +447,7 @@ fiExpr dflags to_drop (_, AnnCase scrut case_bndr _ [(con,alt_bndrs,rhs)])
     scrut_fvs  = freeVarsOf scrut
 
     [shared_binds, scrut_binds, rhs_binds]
-       = sepBindsByDropPoint dflags False
+       = sepBindsByDropPoint dflags SepVanilla
            [scrut_fvs, rhs_fvs]
            to_drop
 
@@ -456,16 +457,17 @@ fiExpr dflags to_drop (_, AnnCase scrut case_bndr ty alts)
     Case (fiExpr dflags scrut_drops scrut) case_bndr ty
          (zipWith fi_alt alts_drops_s alts)
   where
-        -- Float into the scrut and alts-considered-together just like App
+     -- Float into the scrut and alts-considered-together just like App
     [drop_here1, scrut_drops, alts_drops]
-       = sepBindsByDropPoint dflags False
+       = sepBindsByDropPoint dflags SepVanilla
            [scrut_fvs, all_alts_fvs]
            to_drop
 
-        -- Float into the alts with the is_case flag set
+     -- Float into the alts with the SepCase context set
     (drop_here2 : alts_drops_s)
       | [ _ ] <- alts = [] : [alts_drops]
-      | otherwise     = sepBindsByDropPoint dflags True alts_fvs alts_drops
+      | otherwise     = sepBindsByDropPoint dflags SepCase
+                                            alts_fvs alts_drops
 
     scrut_fvs    = freeVarsOf scrut
     alts_fvs     = map alt_fvs alts
@@ -491,7 +493,7 @@ fiBind dflags to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs
   = ( extra_binds ++ shared_binds          -- Land these before
                                            -- See Note [extra_fvs (1,2)]
     , FB (unitDVarSet id) rhs_fvs'         -- The new binding itself
-          (FloatLet (NonRec id rhs'))
+         (FloatLet (NonRec id rhs'))
     , body_binds )                         -- Land these after
 
   where
@@ -508,7 +510,8 @@ fiBind dflags to_drop (AnnNonRec id ann_rhs@(rhs_fvs, rhs)) body_fvs
         -- But do float into join points
 
     [shared_binds, extra_binds, rhs_binds, body_binds]
-        = sepBindsByDropPoint dflags False
+        = sepBindsByDropPoint dflags
+            (if isJoinId id then SepNonRecJoin else SepVanilla)
             [extra_fvs, rhs_fvs, body_fvs2]
             to_drop
 
@@ -533,7 +536,7 @@ fiBind dflags to_drop (AnnRec bindings) body_fvs
                               , noFloatIntoRhs Recursive bndr rhs ]
 
     (shared_binds:extra_binds:body_binds:rhss_binds)
-        = sepBindsByDropPoint dflags False
+        = sepBindsByDropPoint dflags SepVanilla
             (extra_fvs:body_fvs:rhss_fvs)
             to_drop
 
@@ -654,9 +657,41 @@ We have to maintain the order on these drop-point-related lists.
 -- pprFIB :: FloatInBinds -> SDoc
 -- pprFIB fibs = text "FIB:" <+> ppr [b | FB _ _ b <- fibs]
 
+data SepCtxt
+  = SepCase
+  | SepNonRecJoin
+  | SepVanilla
+
+{- Note [Floating join points]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We push join-point bindings inwards merrily, just like let-bindings.
+They may get floated out again; e.g.
+   join j1 x = e1
+   in join j2 y = ...j1...
+   in ...
+==>
+   join j2 y = join { j1 x = e1 } in ...j1...
+   in ...
+
+Here we might float j1 out again.  But we must float it in in case it
+allows an ordinary let-binding to go too.  E.g.
+   let x = <thunk>
+   in join j1 x = e1
+   in join j2 y = ...j1...
+   in ...
+===>
+   join j2 y = let { x = <thunk }
+               in join { j1 x = e1 }
+               in ...j1...
+   in ...
+
+Ths is important; now the thunk for 'x' may not be allocated on the
+paths that don't involve j2.
+-}
+
 sepBindsByDropPoint
     :: DynFlags
-    -> Bool                -- True <=> is case expression
+    -> SepCtxt
     -> [FreeVarSet]        -- One set of FVs per drop point
                            -- Always at least two long!
     -> FloatInBinds        -- Candidate floaters
@@ -672,15 +707,15 @@ sepBindsByDropPoint
 
 type DropBox = (FreeVarSet, FloatInBinds)
 
-sepBindsByDropPoint dflags is_case drop_pts floaters
+sepBindsByDropPoint dflags sep_ctxt drop_pts floaters
   | null floaters  -- Shortcut common case
   = [] : [[] | _ <- drop_pts]
 
   | otherwise
-  = ASSERT( drop_pts `lengthAtLeast` 2 )
+  = ASSERT( n_alts >= 2 )  -- Invariant on caller
     go floaters (map (\fvs -> (fvs, [])) (emptyDVarSet : drop_pts))
   where
-    n_alts = length drop_pts
+    n_alts = length drop_pts  -- n_alts >= 2
 
     go :: FloatInBinds -> [DropBox] -> [FloatInBinds]
         -- The *first* one in the argument list is the drop_here set
@@ -697,18 +732,29 @@ sepBindsByDropPoint dflags is_case drop_pts floaters
           (used_here : used_in_flags) = [ fvs `intersectsDVarSet` bndrs
                                         | (fvs, _) <- drop_boxes]
 
-          drop_here = used_here || cant_push
+          drop_here = used_here || not want_push
+          want_push = case sep_ctxt of
+                          SepCase       -> want_case_push
+                          SepNonRecJoin -> want_join_push
+                          SepVanilla    -> want_let_push
 
           n_used_alts = count id used_in_flags -- returns number of Trues in list.
 
-          cant_push
-            | is_case   = n_used_alts == n_alts   -- Used in all, don't push
+          no_duplication = n_used_alts <= 1  -- See Note [Duplicating floats]
+
+          duplicable_float = floatIsDupable dflags bind
+                             -- True <=> duplication does not dup much code
+                             --          (but it might still duplicate work!)
+                             -- See Note [Duplicating floats]
+
+          want_case_push = -- n_used_alts < n_alts &&   -- Used in all alts, don't push
                                                   -- Remember n_alts > 1
-                          || (n_used_alts > 1 && not (floatIsDupable dflags bind))
-                             -- floatIsDupable: see Note [Duplicating floats]
+                         (no_duplication || duplicable_float)
 
-            | otherwise = floatIsCase bind || n_used_alts > 1
-                             -- floatIsCase: see Note [Floating primops]
+          want_let_push = not (floatIsCase bind)  -- See Note [Floating primops]
+                       && no_duplication
+
+          want_join_push = no_duplication         -- See Note [Floating join points]
 
           new_boxes | drop_here = (insert here_box : fork_boxes)
                     | otherwise = (here_box : new_fork_boxes)
@@ -727,18 +773,43 @@ sepBindsByDropPoint dflags is_case drop_pts floaters
 
 {- Note [Duplicating floats]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+no_duplication is true if the binding us used in at most one
+alternative.  (Zero is rare; it means the binding is dead.)
+
+If no_duplication is false, we may still float:
 
-For case expressions we duplicate the binding if it is reasonably
-small, and if it is not used in all the RHSs This is good for
-situations like
+* For /case expressions/ only (SepCase) we duplicate the binding if it
+  is reasonably small, and if it is not used in all the RHSs. This is
+  good for situations like
      let x = I# y in
      case e of
        C -> error x
        D -> error x
        E -> ...not mentioning x...
 
-If the thing is used in all RHSs there is nothing gained,
-so we don't duplicate then.
+  If the thing is used in all RHSs there is nothing gained,
+  so we don't duplicate then.
+
+* This is NOT GOOD for other float-in places, like lets (SepVanilla).
+  Consider
+     let x = <small> in
+     let v = ...x...
+     in ...x...
+
+  We definitely don't want to duplicate x into the RHS of v and the
+  body!  At least, it would be OK if <small> was a value; but we don't
+  test that.
+
+* For non-recursive join bindings (SepNonRecJoin) we must be equally
+  careful.  Eg
+     let x = <small> in
+     join j = ...x...
+     in case f x of
+          A -> j
+          B -> something else
+          C -> j
+  Here we must not duplicate the let-x binding into the RHS of j
+  and the body, or we'll duplicate the redex.
 -}
 
 floatedBindsFVs :: FloatInBinds -> FreeVarSet
@@ -754,9 +825,19 @@ wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e)
 
 floatIsDupable :: DynFlags -> FloatBind -> Bool
 floatIsDupable dflags (FloatCase scrut _ _ _) = exprIsDupable dflags scrut
-floatIsDupable dflags (FloatLet (Rec prs))    = all (exprIsDupable dflags . snd) prs
-floatIsDupable dflags (FloatLet (NonRec _ r)) = exprIsDupable dflags r
+floatIsDupable dflags (FloatLet (Rec prs))    = -- all (exprIsDupable dflags . snd) prs
+                                                all (smallEnough dflags) prs
+floatIsDupable dflags (FloatLet (NonRec b r)) = -- exprIsDupable dflags r
+                                                smallEnough dflags (b,r)
+
+smallEnough :: DynFlags -> (Id,CoreExpr) -> Bool
+smallEnough dflags (_,rhs)
+  = couldBeSmallEnoughToInline dflags (ufUseThreshold dflags) rhs
 
 floatIsCase :: FloatBind -> Bool
 floatIsCase (FloatCase {}) = True
 floatIsCase (FloatLet {})  = False
+
+--floatIsJoin :: FloatBind -> Bool
+--floatIsJoin (FloatCase {}) = False
+--floatIsJoin (FloatLet b)   = isJoinBind b
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index ca1b9bd23d..82d20e20c5 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1271,6 +1271,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
   | exprIsTrivial rhs           = True
   | otherwise
   = case occ_info of
+{-
         -- The point of examining occ_info here is that for *non-values*
         -- that occur outside a lambda, the call-site inliner won't have
         -- a chance (because it doesn't know that the thing
@@ -1285,7 +1286,8 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
         -- in allocation if you miss this out
       OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt }
                -- OneOcc => no code-duplication issue
-        ->     smallEnoughToInline dflags unfolding     -- Small enough to dup
+        ->   not (isJoinId bndr)  -- NEW!
+          && smallEnoughToInline dflags unfolding     -- Small enough to dup
                         -- ToDo: consider discount on smallEnoughToInline if int_cxt is true
                         --
                         -- NB: Do NOT inline arbitrarily big things, even if one_br is True
@@ -1310,6 +1312,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
                         -- int_cxt to prevent us inlining inside a lambda without some
                         -- good reason.  See the notes on int_cxt in preInlineUnconditionally
 
+-}
       IAmDead -> True   -- This happens; for example, the case_bndr during case of
                         -- known constructor:  case (a,b) of x { (p,q) -> ... }
                         -- Here x isn't mentioned in the RHS, so we don't want to
@@ -1331,7 +1334,7 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs
 
   where
     unfolding = idUnfolding bndr
-    dflags    = seDynFlags env
+    _dflags    = seDynFlags env
     active    = isActive (sm_phase (getMode env)) (idInlineActivation bndr)
         -- See Note [pre/postInlineUnconditionally in gentle mode]
 
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 872973925f..e3237bfcee 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -45,7 +45,7 @@ import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel,
                           RecFlag(..), Arity )
 import MonadUtils       ( mapAccumLM, liftIO )
 import Var              ( isTyCoVar )
-import Maybes           (  orElse )
+import Maybes           (  isJust, orElse )
 import Control.Monad
 import Outputable
 import FastString
@@ -326,6 +326,7 @@ simplNonRecX :: SimplEnv
 -- simplified, notably in knownCon.  It uses case-binding where necessary.
 --
 -- Precondition: rhs satisfies the let/app invariant
+-- Not used for JoinIds
 
 simplNonRecX env bndr new_rhs
   | ASSERT2( not (isJoinId bndr), ppr bndr )
@@ -350,6 +351,7 @@ completeNonRecX :: TopLevelFlag -> SimplEnv
                 -> SimplM (SimplFloats, SimplEnv)    -- The new binding is in the floats
 -- Precondition: rhs satisfies the let/app invariant
 --               See Note [CoreSyn let/app invariant] in CoreSyn
+-- Not used for JoinIds
 
 completeNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs
   = ASSERT2( not (isJoinId new_bndr), ppr new_bndr )
@@ -549,7 +551,7 @@ makeTrivialWithInfo mode top_lvl occ_fs info expr
         -- Now something very like completeBind,
         -- but without the postInlineUnconditinoally part
         ; (arity, is_bot, expr2) <- tryEtaExpandRhs mode var expr1
-        ; unf <- mkLetUnfolding (sm_dflags mode) top_lvl InlineRhs var expr2
+        ; unf <- simplVanillaUnfolding (sm_dflags mode) top_lvl InlineRhs var expr2
 
         ; let final_id = addLetBndrInfo var arity is_bot unf
               bind     = NonRec final_id expr2
@@ -3390,15 +3392,25 @@ simplLetUnfolding :: SimplEnv-> TopLevelFlag
 simplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty unf
   | isStableUnfolding unf
   = simplStableUnfolding env top_lvl cont_mb id unf rhs_ty
-  | isExitJoinId id
+
+  | isJust cont_mb  -- A join point
+  = simplJoinUnfolding env id new_rhs
+
+  | otherwise
+  = simplVanillaUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs
+
+-------------------
+simplJoinUnfolding :: SimplEnv -> InId -> OutExpr -> SimplM Unfolding
+simplJoinUnfolding env join_id new_rhs
+  | isExitJoinId join_id
   = return noUnfolding -- See Note [Do not inline exit join points] in Exitify
   | otherwise
-  = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs
+  = return (mkJoinUnfolding (seDynFlags env) new_rhs)
 
 -------------------
-mkLetUnfolding :: DynFlags -> TopLevelFlag -> UnfoldingSource
-               -> InId -> OutExpr -> SimplM Unfolding
-mkLetUnfolding dflags top_lvl src id new_rhs
+simplVanillaUnfolding :: DynFlags -> TopLevelFlag -> UnfoldingSource
+                      -> InId -> OutExpr -> SimplM Unfolding
+simplVanillaUnfolding dflags top_lvl src id new_rhs
   = is_bottoming `seq`  -- See Note [Force bottoming field]
     return (mkUnfolding dflags src is_top_lvl is_bottoming new_rhs)
             -- We make an  unfolding *even for loop-breakers*.
@@ -3456,7 +3468,7 @@ simplStableUnfolding env top_lvl mb_cont id unf rhs_ty
                             -- See Note [Top-level flag on inline rules] in CoreUnfold
 
                   _other              -- Happens for INLINABLE things
-                     -> mkLetUnfolding dflags top_lvl src id expr' }
+                     -> simplVanillaUnfolding dflags top_lvl src id expr' }
                 -- If the guidance is UnfIfGoodArgs, this is an INLINABLE
                 -- unfolding, and we need to make sure the guidance is kept up
                 -- to date with respect to any changes in the unfolding.
diff --git a/compiler/typecheck/TcRules.hs-save b/compiler/typecheck/TcRules.hs-save
new file mode 100644
index 0000000000..71139dd68f
--- /dev/null
+++ b/compiler/typecheck/TcRules.hs-save
@@ -0,0 +1,368 @@
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1993-1998
+
+
+TcRules: Typechecking transformation rules
+-}
+
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module TcRules ( tcRules ) where
+
+import GhcPrelude
+
+import HsSyn
+import TcRnTypes
+import TcRnMonad
+import TcSimplify
+import TcMType
+import TcType
+import TcHsType
+import TcExpr
+import TcEnv
+import TcUnify( buildImplicationFor )
+import TcEvidence( mkTcCoVarCo )
+import Type
+import Id
+import Var( EvVar )
+import BasicTypes       ( RuleName )
+import SrcLoc
+import Outputable
+import FastString
+import Bag
+import Data.List( partition )
+
+{-
+Note [Typechecking rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+We *infer* the typ of the LHS, and use that type to *check* the type of
+the RHS.  That means that higher-rank rules work reasonably well. Here's
+an example (test simplCore/should_compile/rule2.hs) produced by Roman:
+
+   foo :: (forall m. m a -> m b) -> m a -> m b
+   foo f = ...
+
+   bar :: (forall m. m a -> m a) -> m a -> m a
+   bar f = ...
+
+   {-# RULES "foo/bar" foo = bar #-}
+
+He wanted the rule to typecheck.
+-}
+
+tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTcId]
+tcRules decls = mapM (wrapLocM tcRuleDecls) decls
+
+tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTcId)
+tcRuleDecls (HsRules src decls)
+   = do { tc_decls <- mapM (wrapLocM tcRule) decls
+        ; return (HsRules src tc_decls) }
+
+tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTcId)
+tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
+  = addErrCtxt (ruleCtxt $ snd $ unLoc name)  $
+    do { traceTc "---- Rule ------" (pprFullRuleName name)
+
+        -- Note [Typechecking rules]
+       ; (vars, bndr_wanted) <- captureConstraints $
+                                tcRuleBndrs hs_bndrs
+              -- bndr_wanted constraints can include wildcard hole
+              -- constraints, which we should not forget about.
+              -- It may mention the skolem type variables bound by
+              -- the RULE.  c.f. Trac #10072
+
+       ; let (id_bndrs, tv_bndrs) = partition isId vars
+       ; (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty)
+            <- tcExtendTyVarEnv tv_bndrs $
+               tcExtendIdEnv    id_bndrs $
+               do { -- See Note [Solve order for RULES]
+                    ((lhs', rule_ty), lhs_wanted) <- captureConstraints (tcInferRho lhs)
+                  ; (rhs', rhs_wanted) <- captureConstraints $
+                                          tcMonoExpr rhs (mkCheckExpType rule_ty)
+                  ; return (lhs', lhs_wanted, rhs', rhs_wanted, rule_ty) }
+
+       ; traceTc "tcRule 1" (vcat [ pprFullRuleName name
+                                  , ppr lhs_wanted
+                                  , ppr rhs_wanted ])
+       ; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted
+       ; (lhs_evs, residual_lhs_wanted) <- simplifyRule (snd $ unLoc name)
+                                              all_lhs_wanted
+                                              rhs_wanted
+
+       -- SimplfyRule Plan, step 4
+       -- Now figure out what to quantify over
+       -- c.f. TcSimplify.simplifyInfer
+       -- We quantify over any tyvars free in *either* the rule
+       --  *or* the bound variables.  The latter is important.  Consider
+       --      ss (x,(y,z)) = (x,z)
+       --      RULE:  forall v. fst (ss v) = fst v
+       -- The type of the rhs of the rule is just a, but v::(a,(b,c))
+       --
+       -- We also need to get the completely-uconstrained tyvars of
+       -- the LHS, lest they otherwise get defaulted to Any; but we do that
+       -- during zonking (see TcHsSyn.zonkRule)
+
+       ; let tpl_ids = lhs_evs ++ id_bndrs
+       ; forall_tkvs <- zonkTcTypesAndSplitDepVars $
+                        rule_ty : map idType tpl_ids
+       ; gbls  <- tcGetGlobalTyCoVars -- Even though top level, there might be top-level
+                                      -- monomorphic bindings from the MR; test tc111
+       ; qtkvs <- quantifyTyVars gbls forall_tkvs
+       ; traceTc "tcRule" (vcat [ pprFullRuleName name
+                                , ppr forall_tkvs
+                                , ppr qtkvs
+                                , ppr rule_ty
+                                , vcat [ ppr id <+> dcolon <+> ppr (idType id) | id <- tpl_ids ]
+                  ])
+
+       -- SimplfyRule Plan, step 5
+       -- Simplify the LHS and RHS constraints:
+       -- For the LHS constraints we must solve the remaining constraints
+       -- (a) so that we report insoluble ones
+       -- (b) so that we bind any soluble ones
+       ; let skol_info = RuleSkol (snd (unLoc name))
+       ; (lhs_implic, lhs_binds) <- buildImplicationFor topTcLevel skol_info qtkvs
+                                         lhs_evs residual_lhs_wanted
+       ; (rhs_implic, rhs_binds) <- buildImplicationFor topTcLevel skol_info qtkvs
+                                         lhs_evs rhs_wanted
+
+       ; emitImplications (lhs_implic `unionBags` rhs_implic)
+       ; return (HsRule name act
+                    (map (noLoc . RuleBndr . noLoc) (qtkvs ++ tpl_ids))
+                    (mkHsDictLet lhs_binds lhs') fv_lhs
+                    (mkHsDictLet rhs_binds rhs') fv_rhs) }
+
+tcRuleBndrs :: [LRuleBndr GhcRn] -> TcM [Var]
+tcRuleBndrs []
+  = return []
+tcRuleBndrs (L _ (RuleBndr (L _ name)) : rule_bndrs)
+  = do  { ty <- newOpenFlexiTyVarTy
+        ; vars <- tcRuleBndrs rule_bndrs
+        ; return (mkLocalId name ty : vars) }
+tcRuleBndrs (L _ (RuleBndrSig (L _ name) rn_ty) : rule_bndrs)
+--  e.g         x :: a->a
+--  The tyvar 'a' is brought into scope first, just as if you'd written
+--              a::*, x :: a->a
+  = do  { let ctxt = RuleSigCtxt name
+        ; (_ , tvs, id_ty) <- tcHsPatSigType ctxt rn_ty
+        ; let id  = mkLocalIdOrCoVar name id_ty
+                    -- See Note [Pattern signature binders] in TcHsType
+
+              -- The type variables scope over subsequent bindings; yuk
+        ; vars <- tcExtendTyVarEnv2 tvs $
+                  tcRuleBndrs rule_bndrs
+        ; return (map snd tvs ++ id : vars) }
+
+ruleCtxt :: FastString -> SDoc
+ruleCtxt name = text "When checking the transformation rule" <+>
+                doubleQuotes (ftext name)
+
+
+{-
+*********************************************************************************
+*                                                                                 *
+              Constraint simplification for rules
+*                                                                                 *
+***********************************************************************************
+
+Note [The SimplifyRule Plan]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Example.  Consider the following left-hand side of a rule
+        f (x == y) (y > z) = ...
+If we typecheck this expression we get constraints
+        d1 :: Ord a, d2 :: Eq a
+We do NOT want to "simplify" to the LHS
+        forall x::a, y::a, z::a, d1::Ord a.
+          f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ...
+Instead we want
+        forall x::a, y::a, z::a, d1::Ord a, d2::Eq a.
+          f ((==) d2 x y) ((>) d1 y z) = ...
+
+Here is another example:
+        fromIntegral :: (Integral a, Num b) => a -> b
+        {-# RULES "foo"  fromIntegral = id :: Int -> Int #-}
+In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But
+we *dont* want to get
+        forall dIntegralInt.
+           fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int
+because the scsel will mess up RULE matching.  Instead we want
+        forall dIntegralInt, dNumInt.
+          fromIntegral Int Int dIntegralInt dNumInt = id Int
+
+Even if we have
+        g (x == y) (y == z) = ..
+where the two dictionaries are *identical*, we do NOT WANT
+        forall x::a, y::a, z::a, d1::Eq a
+          f ((==) d1 x y) ((>) d1 y z) = ...
+because that will only match if the dict args are (visibly) equal.
+Instead we want to quantify over the dictionaries separately.
+
+In short, simplifyRuleLhs must *only* squash equalities, leaving
+all dicts unchanged, with absolutely no sharing.
+
+Also note that we can't solve the LHS constraints in isolation:
+Example   foo :: Ord a => a -> a
+          foo_spec :: Int -> Int
+          {-# RULE "foo"  foo = foo_spec #-}
+Here, it's the RHS that fixes the type variable
+
+HOWEVER, under a nested implication things are different
+Consider
+  f :: (forall a. Eq a => a->a) -> Bool -> ...
+  {-# RULES "foo" forall (v::forall b. Eq b => b->b).
+       f b True = ...
+    #-}
+Here we *must* solve the wanted (Eq a) from the given (Eq a)
+resulting from skolemising the argument type of g.  So we
+revert to SimplCheck when going under an implication.
+
+
+--------- So the SimplifyRule Plan is this -----------------------
+
+* Step 0: typecheck the LHS and RHS to get constraints from each
+
+* Step 1: Simplify the LHS and RHS constraints all together in one bag
+          We do this to discover all unification equalities
+
+* Step 2: Zonk the ORIGINAL (unsimplified) LHS constraints, to take
+          advantage of those unifications
+
+* Setp 3: Partition the LHS constraints into the ones we will
+          quantify over, and the others.
+          See Note [RULE quantification over equalities]
+
+* Step 4: Decide on the type variables to quantify over
+
+* Step 5: Simplify the LHS and RHS constraints separately, using the
+          quantified constraints as givens
+
+Note [Solve order for RULES]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In step 1 above, we need to be a bit careful about solve order.
+Consider
+   f :: Int -> T Int
+   type instance T Int = Bool
+
+   RULE f 3 = True
+
+From the RULE we get
+   lhs-constraints:  T Int ~ alpha
+   rhs-constraints:  Bool ~ alpha
+where 'alpha' is the type that connects the two.  If we glom them
+all together, and solve the RHS constraint first, we might solve
+with alpha := Bool.  But then we'd end up with a RULE like
+
+    RULE: f 3 |> (co :: T Int ~ Booo) = True
+
+which is terrible.  We want
+
+    RULE: f 3 = True |> (sym co :: Bool ~ T Int)
+
+So we are careful to solve the LHS constraints first, and *then* the
+RHS constraints.  Actually much of this is done by the on-the-fly
+constraint solving, so the same order must be observed in
+tcRule.
+
+
+Note [RULE quantification over equalities]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Deciding which equalities to quantify over is tricky:
+ * We do not want to quantify over insoluble equalities (Int ~ Bool)
+    (a) because we prefer to report a LHS type error
+    (b) because if such things end up in 'givens' we get a bogus
+        "inaccessible code" error
+
+ * But we do want to quantify over things like (a ~ F b), where
+   F is a type function.
+
+The difficulty is that it's hard to tell what is insoluble!
+So we see whether the simplification step yielded any type errors,
+and if so refrain from quantifying over *any* equalities.
+
+Note [Quantifying over coercion holes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Equality constraints from the LHS will emit coercion hole Wanteds.
+These don't have a name, so we can't quantify over them directly.
+Instead, because we really do want to quantify here, invent a new
+EvVar for the coercion, fill the hole with the invented EvVar, and
+then quantify over the EvVar. Not too tricky -- just some
+impedance matching, really.
+
+Note [Simplify cloned constraints]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At this stage, we're simplifying constraints only for insolubility
+and for unification. Note that all the evidence is quickly discarded.
+We use a clone of the real constraint. If we don't do this,
+then RHS coercion-hole constraints get filled in, only to get filled
+in *again* when solving the implications emitted from tcRule. That's
+terrible, so we avoid the problem by cloning the constraints.
+
+-}
+
+simplifyRule :: RuleName
+             -> WantedConstraints       -- Constraints from LHS
+             -> WantedConstraints       -- Constraints from RHS
+             -> TcM ( [EvVar]               -- Quantify over these LHS vars
+                    , WantedConstraints)    -- Residual un-quantified LHS constraints
+-- See Note [The SimplifyRule Plan]
+-- NB: This consumes all simple constraints on the LHS, but not
+-- any LHS implication constraints.
+simplifyRule name lhs_wanted rhs_wanted
+  = do {         -- We allow ourselves to unify environment
+                 -- variables: runTcS runs with topTcLevel
+       ; lhs_clone <- cloneWC lhs_wanted
+       ; rhs_clone <- cloneWC rhs_wanted
+
+       -- Note [The SimplifyRule Plan] step 1
+       -- First solve the LHS and *then* solve the RHS
+       -- Crucially, this performs unifications
+       -- See Note [Solve order for RULES]
+       -- See Note [Simplify cloned constraints]
+       ; runTcSDeriveds $
+         do { _ <- solveWanteds lhs_clone
+            ; _ <- solveWanteds rhs_clone
+            ; return () }
+
+       -- Note [The SimplifyRule Plan] step 2
+       ; zonked_lhs_simples <- zonkSimples (wc_simple lhs_wanted)
+
+       -- Note [The SimplifyRule Plan] step 3
+       ; let (quant_cts, no_quant_cts) = partitionBag quantify_ct
+                                                      zonked_lhs_simples
+
+       ; quant_evs <- mapM mk_quant_ev (bagToList quant_cts)
+
+       ; traceTc "simplifyRule" $
+         vcat [ text "LHS of rule" <+> doubleQuotes (ftext name)
+              , text "lhs_wanted" <+> ppr lhs_wanted
+              , text "rhs_wanted" <+> ppr rhs_wanted
+              , text "zonked_lhs_simples" <+> ppr zonked_lhs_simples
+              , text "quant_cts" <+> ppr quant_cts
+              , text "no_quant_cts" <+> ppr no_quant_cts
+              ]
+
+       ; return (quant_evs, lhs_wanted { wc_simple = no_quant_cts }) }
+
+  where
+    quantify_ct :: Ct -> Bool
+    quantify_ct ct
+      | isGivenCt ct     = False
+      | isHoleCt ct      = False
+      | insolubleEqCt ct = False -- Note [RULE quantification over equalities]
+      | EqPred _ t1 t2 <- classifyPredType (ctPred ct)
+      = not (t1 `tcEqType` t2)
+      | otherwise
+      = True
+
+    mk_quant_ev :: Ct -> TcM EvVar
+    mk_quant_ev ct
+      | CtWanted { ctev_dest = dest, ctev_pred = pred } <- ctEvidence ct
+      = case dest of
+          EvVarDest ev_id -> return ev_id
+          HoleDest hole   -> -- See Note [Quantifying over coercion holes]
+                             do { ev_id <- newEvVar pred
+                                ; fillCoercionHole hole (mkTcCoVarCo ev_id)
+                                ; return ev_id }
+    mk_quant_ev ct = pprPanic "mk_quant_ev" (ppr ct)
diff --git a/libraries/base/GHC/IO/Encoding/UTF8.hs b/libraries/base/GHC/IO/Encoding/UTF8.hs
index 18d034ad15..5ed21fbad9 100644
--- a/libraries/base/GHC/IO/Encoding/UTF8.hs
+++ b/libraries/base/GHC/IO/Encoding/UTF8.hs
@@ -24,11 +24,14 @@
 --
 -----------------------------------------------------------------------------
 
+
 module GHC.IO.Encoding.UTF8 (
   utf8, mkUTF8,
   utf8_bom, mkUTF8_bom
   ) where
 
+-- module GHC.IO.Encoding.UTF8 where
+
 import GHC.Base
 import GHC.Real
 import GHC.Num
@@ -40,6 +43,156 @@ import GHC.IO.Encoding.Types
 import GHC.Word
 import Data.Bits
 
+{-
+utf8_decode :: DecodeBuffer
+utf8_decode 
+  input@Buffer{  bufRaw=iraw, bufL=ir0, bufR=iw,  bufSize=_  }
+  output@Buffer{ bufRaw=oraw, bufL=_,   bufR=ow0, bufSize=os }
+ = let 
+       loop !ir !ow
+         | ow >= os = done OutputUnderflow ir ow
+         | ir >= iw = done InputUnderflow ir ow
+         | otherwise = do
+              c0 <- readWord8Buf iraw ir
+              case c0 of
+                _ | c0 <= 0x7f -> do 
+                           ow' <- writeCharBuf oraw ow (unsafeChr (fromIntegral c0))
+                           loop (ir+1) ow'
+                  | c0 >= 0xc0 && c0 <= 0xc1 -> invalid -- Overlong forms
+                  | c0 >= 0xc2 && c0 <= 0xdf ->
+                           if iw - ir < 2 then done InputUnderflow ir ow else do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if (c1 < 0x80 || c1 >= 0xc0) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr2 c0 c1)
+                           loop (ir+2) ow'
+                  | c0 >= 0xe0 && c0 <= 0xef ->
+                      case iw - ir of
+                        1 -> done InputUnderflow ir ow
+                        2 -> do -- check for an error even when we don't have
+                                -- the full sequence yet (#3341)
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if not (validate3 c0 c1 0x80) 
+                              then invalid else done InputUnderflow ir ow
+                        _ -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           if not (validate3 c0 c1 c2) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr3 c0 c1 c2)
+                           loop (ir+3) ow'
+                  | c0 >= 0xf0 ->
+                      case iw - ir of
+                        1 -> done InputUnderflow ir ow
+                        2 -> do -- check for an error even when we don't have
+                                -- the full sequence yet (#3341)
+                           c1 <- readWord8Buf iraw (ir+1)
+                           if not (validate4 c0 c1 0x80 0x80)
+                              then invalid else done InputUnderflow ir ow
+                        3 -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           if not (validate4 c0 c1 c2 0x80)
+                              then invalid else done InputUnderflow ir ow
+                        _ -> do
+                           c1 <- readWord8Buf iraw (ir+1)
+                           c2 <- readWord8Buf iraw (ir+2)
+                           c3 <- readWord8Buf iraw (ir+3)
+                           if not (validate4 c0 c1 c2 c3) then invalid else do
+                           ow' <- writeCharBuf oraw ow (chr4 c0 c1 c2 c3)
+                           loop (ir+4) ow'
+                  | otherwise ->
+                           invalid
+         where
+           invalid = done InvalidSequence ir ow
+
+       -- lambda-lifted, to avoid thunks being built in the inner-loop:
+       done why !ir !ow = return (why,
+                                  if ir == iw then input{ bufL=0, bufR=0 }
+                                              else input{ bufL=ir },
+                                  output{ bufR=ow })
+   in
+   loop ir0 ow0
+
+validate4             :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate4 #-}
+validate4 x1 x2 x3 x4 = validate4_1 ||
+                        validate4_2 ||
+                        validate4_3
+  where 
+    validate4_1 = x1 == 0xF0 &&
+                  between x2 0x90 0xBF &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+    validate4_2 = between x1 0xF1 0xF3 &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+    validate4_3 = x1 == 0xF4 &&
+                  between x2 0x80 0x8F &&
+                  between x3 0x80 0xBF &&
+                  between x4 0x80 0xBF
+
+validate3          :: Word8 -> Word8 -> Word8 -> Bool
+{-# INLINE validate3 #-}
+validate3 x1 x2 x3 = validate3_1 ||
+                     validate3_2 ||
+                     validate3_3 ||
+                     validate3_4
+  where
+    validate3_1 = (x1 == 0xE0) &&
+                  between x2 0xA0 0xBF &&
+                  between x3 0x80 0xBF
+    validate3_2 = between x1 0xE1 0xEC &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF
+    validate3_3 = x1 == 0xED &&
+                  between x2 0x80 0x9F &&
+                  between x3 0x80 0xBF
+    validate3_4 = between x1 0xEE 0xEF &&
+                  between x2 0x80 0xBF &&
+                  between x3 0x80 0xBF
+
+between :: Word8                -- ^ byte to check
+        -> Word8                -- ^ lower bound
+        -> Word8                -- ^ upper bound
+        -> Bool
+between x y z = x >= y && x <= z
+{-# INLINE between #-}
+
+chr2       :: Word8 -> Word8 -> Char
+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
+      !z2# = y2# -# 0x80#
+{-# INLINE chr2 #-}
+
+chr3          :: Word8 -> Word8 -> Word8 -> Char
+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !y3# = word2Int# x3#
+      !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
+      !z3# = y3# -# 0x80#
+{-# INLINE chr3 #-}
+
+chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char
+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
+    C# (chr# (z1# +# z2# +# z3# +# z4#))
+    where
+      !y1# = word2Int# x1#
+      !y2# = word2Int# x2#
+      !y3# = word2Int# x3#
+      !y4# = word2Int# x4#
+      !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
+      !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#
+      !z4# = y4# -# 0x80#
+{-# INLINE chr4 #-}
+-}
+
 utf8 :: TextEncoding
 utf8 = mkUTF8 ErrorOnCodingFailure
 
@@ -359,4 +512,3 @@ validate4 x1 x2 x3 x4 = validate4_1 ||
                   between x2 0x80 0x8F &&
                   between x3 0x80 0xBF &&
                   between x4 0x80 0xBF
-
diff --git a/libraries/dph b/libraries/dph
new file mode 160000
+Subproject 64eca669f13f4d216af9024474a3fc73ce10179
diff --git a/libraries/haskell2010 b/libraries/haskell2010
new file mode 160000
+Subproject c0c87ad53e377aa00f4897bc729c261459b6048
diff --git a/libraries/haskell98 b/libraries/haskell98
new file mode 160000
+Subproject cc6bbbf2bf4eaea57062043cbb6e7c5d6c2f42a
diff --git a/libraries/hoopl b/libraries/hoopl
new file mode 160000
+Subproject ac24864c2db7951a6f34674e2b11b69d37ef84f
diff --git a/libraries/primitive b/libraries/primitive
new file mode 160000
+Subproject 53f72ce69a4dfde5345cf5809a8b4a199352336
diff --git a/libraries/random b/libraries/random
new file mode 160000
+Subproject c72dd0a01ae6255bead2d4fad33f002bb568403
diff --git a/libraries/vector b/libraries/vector
new file mode 160000
+Subproject 224eccbac0125b7bd302f24063bbb473b2c2e1d