[disabled buggy unused transformation in type analysis pass
John Meacham <john@repetae.net>**20120220031442
 Ignore-this: 8ad84739daff7f4faff0ba251898ea1a
] hunk ./src/DataConstructors.hs 304
-typesCompatable :: forall m . Monad m => DataTable -> E -> E -> m ()
-typesCompatable dataTable a b = f etherealIds a b where
+typesCompatable :: forall m . Monad m => E -> E -> m ()
+typesCompatable a b = f etherealIds a b where
hunk ./src/DataConstructors.hs-boot 10
-typesCompatable :: Monad m => DataTable -> E -> E -> m ()
+typesCompatable :: Monad m => E -> E -> m ()
hunk ./src/E/Main.hs 31
+import E.Values
hunk ./src/E/Main.hs 558
+    boxify (from_unsafeCoerce -> Just (e,t)) = do
+        t' <- boxify t
+        e' <- boxify e
+        case typesCompatable t' (getType e') of
+            Just () -> return e
+            _ -> return $ prim_unsafeCoerce e' t'
hunk ./src/E/TypeAnalysis.hs 42
-    envValSupply :: Supply TVr Bool,
-    envEnv :: IdMap [Value Typ]
+    envValSupply  :: Supply TVr Bool,
+    envEnv        :: IdMap [Value Typ]
hunk ./src/E/TypeAnalysis.hs 119
+                hrg x y = error $ "TypeAnalyis.hrg: " ++ show (x,y)
hunk ./src/E/TypeAnalysis.hs 166
-calcAlt env v (Alt LitCons { litName = n, litArgs = xs } e) = do
+calcAlt env v (Alt ~LitCons { litName = n, litArgs = xs } e) = do
hunk ./src/E/TypeAnalysis.hs 214
-getValue e = fail $ "getValue: " ++ show e
hunk ./src/E/TypeAnalysis.hs 233
-    f n kind vm | Just [] <- vmapHeads vm = return $ tAbsurd kind  -- TODO - absurdize values properly
+    f n kind vm | Just [] <- vmapHeads vm = return $ tAbsurd kind
hunk ./src/E/TypeAnalysis.hs 250
-    (nds,_) <- specializeCombs doSpecialize SpecEnv { senvUnusedRules = unusedRules
-                                                    , senvUnusedVars = unusedValues
-                                                    , senvDataTable = progDataTable prog
-                                                    , senvArgs = mempty } (progCombinators prog)
+    (nds,_) <- specializeCombs doSpecialize SpecEnv
+        { senvUnusedRules = unusedRules
+        , senvUnusedVars = unusedValues
+        , senvDataTable = progDataTable prog
+        , senvArgs = mempty } (progCombinators prog)
hunk ./src/E/TypeAnalysis.hs 260
-{-
-specializeComb doSpecialize env comb = do
-    ((t,e),nds) <- specializeDef doSpecialize env (combHead comb,combBody comb)
-    return (combHead_s t . combBody_s e $ comb,nds)
--}
-
hunk ./src/E/TypeAnalysis.hs 284
-
hunk ./src/E/TypeAnalysis.hs 306
+--    f t ty e | isFullyConst ty = return $
+--        prim_unsafeCoerce (subst t ty e) (getType e)
hunk ./src/E/TypeAnalysis.hs 320
-caseCast t _ty e = e
hunk ./src/E/TypeAnalysis.hs 322
-specAlt env@SpecEnv { senvDataTable = dataTable } (Alt lc@LitCons { litArgs = ts } e) = ans where
+specAlt env@SpecEnv { senvDataTable = dataTable } (Alt ~lc@LitCons { litArgs = ts } e) = ans where
hunk ./src/E/TypeAnalysis.hs 335
-isUnused SpecEnv { senvUnusedVars = unusedVars } v = v `member` unusedVars && isJust (Info.lookup $ tvrInfo v :: Maybe Typ)
+isUnused SpecEnv { senvUnusedVars = unusedVars } v =
+    v `member` unusedVars && isJust (Info.lookup $ tvrInfo v :: Maybe Typ)
hunk ./src/E/TypeAnalysis.hs 339
-specBody _ env e | (EVar h,as) <- fromAp e, isUnused env h  = do
-    Stats.mtick $ "Specialize.delete.{" ++ pprint h ++ "}"
-    return $ foldl EAp (EError ("Unused: " ++ pprint h) (getType h)) as
+--specBody _ env e | (EVar h,as) <- fromAp e, isUnused env h  = do
+--    Stats.mtick $ "Specialize.delete.{" ++ pprint h ++ "}"
+--    return $ foldl EAp (EError ("Unused: " ++ pprint h) (getType h)) as
hunk ./src/E/TypeAnalysis.hs 356
-specializeDs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable }  ds = do
+specializeDs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable } ds = do
hunk ./src/E/TypeAnalysis.hs 368
-specializeCombs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable }  ds = do
+specializeCombs doSpecialize env@SpecEnv { senvUnusedRules = unusedRules, senvDataTable = dataTable } ds = do
hunk ./src/E/TypeAnalysis.hs 403
-
hunk ./src/E/TypeAnalysis.hs 404
-
-{-
-
--- pruning the unused branches of typecase statements
-
-pruneE :: E -> IO E
-pruneE e = return $ runIdentity (prune e)  where
-    prune ec@ECase { eCaseScrutinee = EVar v } | sortKindLike (getType v), Just vm <- Info.lookup (tvrInfo v) = do
-        ec' <- pruneCase ec vm
-        emapE' prune ec'
-    prune e = emapE' prune e
-
-pruneCase :: (Monad m) => E -> VMap () Name -> m E
-pruneCase ec ns = return $ if null (caseBodies nec) then err else nec where
-    err = EError "pruneCase: all alternatives pruned" (getType ec)
-    nec = caseUpdate ec { eCaseAlts = f [] $ eCaseAlts ec, eCaseDefault = cd (eCaseDefault ec)}
-    f xs [] = reverse xs
-    f xs (alt@(Alt LitCons { litName = n } _):rs) | not (n `vmapMember` ns) = f xs rs
-    f xs (alt:rs) = f (alt:xs) rs
-    cd (Just d) | Just nns <- vmapHeads ns, or [ n `notElem` as | n <- nns ] = Just d
-                | Nothing <- vmapHeads ns = Just d
-    cd Nothing = Nothing
-    -- The reason we do this is because for a typecase, we need a valid default in order to get the most general type
-    cd (Just d) = Just $ EError "pruneCase: default pruned" (getType d)
-    as = [ n | LitCons { litName = n } <- casePats ec ]
-
--}
hunk ./src/E/TypeCheck.hs 371
-        case typesCompatable dataTable e1 e2 of
+        case typesCompatable e1 e2 of