New patches: [jhc-prim changes John Meacham **20110131060606 Ignore-this: c715ddc556eed049253e89dc9f76c096 ] hunk ./lib/jhc-prim/Jhc/Prim.hs 3 module Jhc.Prim where +foreign import primitive "unsafeCoerce" unsafeCoerce__ :: a -> b + +-- like 'const' but creates an artificial dependency on its second argument to guide optimization. +foreign import primitive dependingOn :: a -> b -> a hunk ./lib/jhc-prim/Jhc/Prim/IO.hs 8 type STRep s a = State_ s -> (# State_ s, a #) type World__ = State_ RealWorld -type UIO = STRep RealWorld +type UIO a = STRep RealWorld a type UIO_ = World__ -> World__ [don't treat promote or demote in tail call position as tail call safe John Meacham **20110131061557 Ignore-this: d3f887d2f98df5c7e93bc2de335b5d36 ] hunk ./src/Grin/Noodle.hs 66 f (BaseOp a vs) = return (BaseOp a) `ap` mapM g vs f (Return vs) = return Return `ap` mapM g vs f (Prim x vs t) = return (Prim x) `ap` mapM g vs `ap` return t --- f (Store v) = return Store `ap` g v f e@Alloc { expValue = v, expCount = c } = do v <- g v c <- g c hunk ./src/Grin/Noodle.hs 163 valIsConstant ValPrim {} = True valIsConstant _ = False - - +-- NOPs will not produce any code at run-time so we can tail-call through them. +isNop (BaseOp Promote _) = True +isNop (BaseOp Demote _) = True +isNop _ = False isOmittable (BaseOp Promote _) = True isOmittable (BaseOp Demote _) = True hunk ./src/Grin/Noodle.hs 195 collectFuncs exp = runWriter (cfunc exp) where clfunc (l :-> r) = cfunc r cfunc e | False && trace ("isManifestNode: " ++ show e) False = undefined + cfunc (e :>>= v :-> op@(BaseOp _ v')) | isNop op && v == v' = do cfunc e cfunc (e :>>= y) = do xs <- cfunc e tell xs [flip the order of dropped slots (TODO: needs regression test) John Meacham **20110131093428 Ignore-this: ae618e53f951fb480d2c05ad6a36b395 ] hunk ./src/DataConstructors.hs 735 Identity pc = getConstructor (conInhabits mc) wdt sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ] slotTypes wdt n kind - | sortKindLike kind, (e,ts) <- fromPi kind = drop (length ts) (conSlots mc) + | sortKindLike kind, (e,ts) <- fromPi kind = take (length (conSlots mc) - length ts) (conSlots mc) + -- | sortKindLike kind, (e,ts) <- fromPi kind = (conSlots mc) where Identity mc = getConstructor n wdt slotTypes wdt n e | Just fa <- followAlias wdt e = slotTypes wdt n fa slotTypes _ n e = error $ "slotTypes: error in " ++ show n ++ ": " ++ show e hunk ./src/DataConstructors.hs 753 Identity pc = getConstructor (conInhabits mc) wdt sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ] slotTypesHs wdt n kind - | sortKindLike kind, (e,ts) <- fromPi kind = drop (length ts) (conSlots mc) + | sortKindLike kind, (e,ts) <- fromPi kind = take (length (conSlots mc) - length ts) (conSlots mc) where Identity mc = getConstructor n wdt slotTypesHs wdt n e | Just fa <- followAlias wdt e = slotTypes wdt n fa slotTypesHs _ n e = error $ "slotTypes: error in " ++ show n ++ ": " ++ show e [cleanups John Meacham **20110131102415 Ignore-this: fa876b1352aa63f667564238a946d06a ] hunk ./src/E/Traverse.hs 1 - module E.Traverse( emapE_, emapE, hunk ./src/E/Traverse.hs 33 mempty = MInt 0 mappend (MInt a) (MInt b) = a `seq` b `seq` MInt (a + b) - runRename :: IdSet -> E -> (E,IdSet) runRename set e = renameE set mempty e hunk ./src/E/Traverse.hs 36 - emapE_ :: Monad m => (E -> m a) -> E -> m () emapE_ f e = emapEG f' f' e >> return () where f' e = f e >> return e hunk ./src/E/Traverse.hs 44 emapEG f g e = emapEGH f g g e +-- map subexpressions +-- emapEGH f g h +-- f - applied to direct subexpressions +-- g - applied to the type-level subexpressions +-- h - applied to the types of variables that occur in value position emapEGH f g h e = z e where z (EAp aa ab) = do aa <- f aa;ab <- f ab; return $ EAp aa ab z (ELam aa ab) = do aa <- mapmTvr g aa; ab <- f ab; return $ ELam aa ab hunk ./src/E/Traverse.hs 80 l' <- T.mapM g l return (Alt l' e') - - instance HasSize E where size = eSize hunk ./src/E/Traverse.hs 91 f e@EError {} = tell (MInt 1) >> return e f e = tell (MInt 1) >> emapE' f e - renameE :: IdSet -> IdMap E -> E -> (E,IdSet) renameE initSet initMap e = runReader (runIdNameT $ addBoundNamesIdMap initMap >> addBoundNamesIdSet initSet >> f e) initMap where f,f' :: E -> IdNameT (Reader (IdMap E)) E hunk ./src/E/Traverse.hs 162 e' <- localSubst n (f e) return $ elam tv' e' - scopeCheck :: Monad m => Bool -> IdMap TVr -> E -> m () scopeCheck checkFvs initMap e = runReaderT (f e) initMap where f (ELam tvr e) = f (tvrType tvr) >> local (minsert (tvrIdent tvr) tvr) (f e) hunk ./src/E/Traverse.hs 184 doAlt (Alt LitCons { litArgs = xs, litType = t } e) = do f t >> local (fromList [ (tvrIdent t,t) | t <- xs] `mappend`) (f e) doAlt (Alt (LitInt _ t) e) = f t >> f e - - - Context: [respect LIB_OPTIONS when building external libraries John Meacham **20110131093918 Ignore-this: 90f357769832f80cb688556eba716c7 ] [add more context to failing type checks John Meacham **20110131093402 Ignore-this: a96fedb951b5fab89ef43975f452f53e ] [Create proper values for conjured Absured and Box types John Meacham **20110131091932 Ignore-this: 7268db023bcc4dc5ee37de2bb2480c59 ] [make Show instance for E more readable John Meacham **20110131061823 Ignore-this: f9aeec02995ca244555d43e0b3a3beb9 ] [when doing --show-ho on a library, print more info. John Meacham **20110131040545 Ignore-this: b14af67358f625f0db3c1dec68358f4 ] [add deepseq and filepath to the libraries John Meacham **20110131015719 Ignore-this: dbd843a9ae9e7bf2183daf1abfe62c74 ] [TAG 0.7.7 John Meacham **20110130044344 Ignore-this: 820062d6ae4e24c72d1ed89d8519b680 ] Patch bundle hash: 9d40405be6edbb63a293e67700bbd1a82e1d2b09