[prev in list] [next in list] [prev in thread] [next in thread]
List: haskell-jhc
Subject: [jhc] darcs patch: clean up Options.hs,
From: John Meacham <john () repetae ! net>
Date: 2011-01-30 3:54:40
Message-ID: 20110130035440.B981764237 () sliver ! repetae ! net
[Download RAW message or body]
Sat Jan 29 18:24:39 PST 2011 John Meacham <john@repetae.net>
* clean up Options.hs, allow setting the garbage collector via the ini fi=
le.
Sat Jan 29 19:06:43 PST 2011 John Meacham <john@repetae.net>
* cleanup
["clean-up-options_hs_-allow-setting-the-garbage-collector-via-the-ini-file_.dpatch" (text/x-darcs-patch)]
New patches:
[clean up Options.hs, allow setting the garbage collector via the ini file.
John Meacham <john@repetae.net>**20110130022439
Ignore-this: 1b15e475c58107d6cd01425e74dca40c
] hunk ./src/Options.hs 193
} {-!derive: update !-}
-opt = Opt {
+emptyOpt = Opt {
optMode = CompileExe,
optColumns = getColumns,
optCross = False,
hunk ./src/Options.hs 330
-- | Parse commandline options.
processOptions :: IO Opt
processOptions = do
+ -- initial argument processing
argv <- getArguments
let (o,ns,rc) = getOpt Permute theoptions argv
hunk ./src/Options.hs 333
+ o <- return (foldl (flip ($)) emptyOpt o)
when (rc /= []) $ putErrLn (concat rc ++ helpUsage) >> exitWith exitCodeUsage
hunk ./src/Options.hs 335
- o1 <- either putErrDie return $ postProcessFD (foldl (flip ($)) opt o)
- o2 <- either putErrDie return $ postProcessFO o1
- case optMode o2 of
+ case optMode o of
ShowHelp -> doShowHelp
ShowConfig -> doShowConfig
StopError s -> putErrLn "bad option passed to --stop should be one of parse, \
deps, typecheck, or c" >> exitWith exitCodeUsage hunk ./src/Options.hs 345
putStrLn $ "-I" ++ VC.datadir ++ "/" ++ VC.package ++ "-" ++ \
VC.shortVersion ++ "/include" exitSuccess
_ -> return ()
+ -- read targets.ini file
Just home <- fmap (`mplus` Just "/") $ lookupEnv "HOME"
hunk ./src/Options.hs 347
- inis <- parseIniFiles (optVerbose o2 > 0) (BS.toString targets_ini) [confDir ++ \
"/targets.ini", confDir ++ "/targets-local.ini", home ++ "/etc/jhc/targets.ini", home \
++ "/.jhc/targets.ini"] (optArch o2)
- when (FlagDump.Ini `S.member` optDumpSet o2) $ flip mapM_ (M.toList inis) $ \
\(a,b) -> putStrLn (a ++ "=" ++ b) + inis <- parseIniFiles (optVerbose o > 0) \
(BS.toString targets_ini) [confDir ++ "/targets.ini", confDir ++ \
"/targets-local.ini", home ++ "/etc/jhc/targets.ini", home ++ "/.jhc/targets.ini"] \
(optArch o) + -- process dump flags
+ o <- either putErrDie return $ postProcessFD o
+ when (FlagDump.Ini `S.member` optDumpSet o) $ flip mapM_ (M.toList inis) $ \
\(a,b) -> putStrLn (a ++ "=" ++ b) + -- set flags based on ini options
+ let o1 = case M.lookup "gc" inis of
+ Just "jgc" -> optFOptsSet_u (S.insert FlagOpts.Jgc) o
+ Just "boehm" -> optFOptsSet_u (S.insert FlagOpts.Boehm) o
+ _ -> o
+ o2 <- either putErrDie return $ postProcessFO o1
+ when (FlagDump.Ini `S.member` optDumpSet o) $ do
+ putStrLn (show $ optDumpSet o)
+ putStrLn (show $ optFOptsSet o)
+ -- add autoloads based on ini options
let autoloads = maybe [] (tokens (',' ==)) (M.lookup "autoload" inis)
o3 = o2 { optArgs = ns, optInis = inis }
case optNoAuto o2 of
[cleanup
John Meacham <john@repetae.net>**20110130030643
Ignore-this: 96b1af39766addb547212ac31f0e9f92
] hunk ./src/E/LetFloat.hs 38
import qualified Info.Info as Info
import qualified Util.Graph as G
-
-
-
-
atomizeApps ::
Bool -- ^ whether to atomize type arguments
-> Program
hunk ./src/E/LetFloat.hs 82
isAtomic e | not atomizeTypes && sortTypeLike e = True
isAtomic e = isFullyConst e
-
-
-
fvBind (Left (_,fv)) = fv
fvBind (Right xs) = unions (snds xs)
hunk ./src/E/LetFloat.hs 85
-
canFloatPast t | sortKindLike . getType $ t = True
canFloatPast t | getType t == tWorldzh = True
canFloatPast t | getProperty prop_ONESHOT t = True
hunk ./src/E/LetFloat.hs 110
--nprog <- programMapBodies (return . floatInward) nprog
return nprog { progStats = nstats }
-
--cupbinds bs = f bs where
-- f (Left ((t,_),fv):rs) = (tvrShowName t,fv):f rs
-- f (Right ds:rs) = f $ map Left ds ++ rs
hunk ./src/E/LetFloat.hs 115
-- f [] = []
-floatInward ::
- E -- ^ input term
+floatInward
+ :: E -- ^ input term
-> E -- ^ output term
hunk ./src/E/LetFloat.hs 118
-floatInward e = floatInwardE e [] where
+floatInward e = floatInwardE e []
floatInwardE :: E -> Binds -> E
floatInwardE e fvs = f e fvs where
hunk ./src/E/LetFloat.hs 166
unsafe_ones = concat [ map (combIdent . fst) vs | vs <- map G.fromScc xs,any \
(not . isCheap) (map (combBody . fst) vs)] ind x = any ( (`elem` uso) . combIdent . \
fst ) (G.fromScc x)
-
-- | seperate bindings based on whether they can be floated inward
hunk ./src/E/LetFloat.hs 167
-
sepByDropPoint ::
[FVarSet] -- ^ list of possible drop points
-> Binds -- ^ list of bindings and their free variables
hunk ./src/E/LetFloat.hs 191
fvDecls (Left (c,_)) = [combIdent c]
fvDecls (Right ts) = [combIdent c | (c,_) <- ts ]
-
newtype Level = Level Int
deriving(Eq,Ord,Enum,Show,Typeable)
hunk ./src/E/LetFloat.hs 229
dds [] nrs e imap = ELetRec (concat nrs) (g n e imap)
g n e imap = runIdentity $ (emapE' (\e -> g' n e imap) e)
g' n e imap = return $ g n e imap
- let imap = Map.fromList $ map (\x -> (x,top_level)) ([ tvrIdent t| (t,_) <- \
programDs prog ] ++ idSetToList (progExternalNames prog `mappend` progSeasoning \
prog)) + let imap = Map.fromList $ map (\x -> (x,top_level)) ([ tvrIdent t| (t,_) \
<- programDs prog ] ++ + idSetToList (progExternalNames prog `mappend` \
progSeasoning prog)) prog <- flip programMapDs prog (\ (t,e) -> do
e' <- letBindAll (progDataTable prog) (progModule prog) e
return $ tl (t,e') imap)
hunk ./src/E/LetFloat.hs 234
-
-
let dofloat ELetRec { eDefs = ds, eBody = e } = do
e' <- dofloat e
ds' <- mapM df ds
hunk ./src/E/LetFloat.hs 281
let nprog = progCombinators_s (concat cds) prog
return nprog { progStats = progStats nprog `mappend` stats }
-
maybeShowName t = if '@' `elem` n then "(epheremal)" else n where
n = tvrShowName t
hunk ./src/E/LetFloat.hs 288
Just y -> toName ns (show modName, "fl@"++show y ++ "$" ++ show u)
Nothing -> toName ns (show modName, "fl@"++show x ++ "$" ++ show u)
-
mapMSnd f xs = sequence [ (,) x `liftM` f y | (x,y) <- xs]
hunk ./src/E/LetFloat.hs 290
-
-letBindAll ::
- DataTable -- ^ the data table for expanding newtypes
+letBindAll
+ :: DataTable -- ^ the data table for expanding newtypes
-> Module -- ^ current module name
-> E -- ^ input term
-> IO E
hunk ./src/E/LetFloat.hs 322
e' <- f e
return (ELetRec [(tv,e')] (EVar tv))
-
-
letRec [] e = e
letRec ds _ | flint && hasRepeatUnder fst ds = error "letRec: repeated variables!"
letRec ds e | flint && any (isUnboxed .tvrType . fst) ds = error "letRec: binding \
unboxed!" hunk ./src/E/LetFloat.hs 326
letRec ds e = ELetRec ds e
-
-
-
hunk ./src/Grin/Grin.hs 72
import StringTable.Atom
import Support.CanType
import Support.FreeVars
-import Util.Perhaps
-import Util.SetLike
import Util.GMap
hunk ./src/Grin/Grin.hs 73
-import Util.HasSize
import Util.Gen
hunk ./src/Grin/Grin.hs 74
+import Util.HasSize
+import Util.Perhaps
+import Util.SetLike
import qualified Cmm.Op as Op
import qualified Info.Info as Info
import qualified Stats
hunk ./src/Grin/Grin.hs 84
-- Extremely simple first order monadic code with basic type system. similar
-- to GRIN except for the explicit typing on variables. Note, that certain
-- haskell types become Grin values, however, nothing may be done with types other
--- than examining them. (types may not be constructed at run-time) ( do we need
--- this for polymorphic recursion? )
-
-data TyThunk =
- TyNotThunk -- ^ not the thunk
- | TyPApp (Maybe Ty) Atom -- ^ can be applied to (possibly) an argument, and \
what results
- | TySusp Atom -- ^ can be evaluated and calls what function
- deriving(Eq,Show)
-
-data TyTy = TyTy {
- tySlots :: [Ty],
- tyReturn :: [Ty],
- tyThunk :: TyThunk,
- tySiblings :: Maybe [Atom]
-}
-
-tyTy = TyTy { tySlots = [], tyReturn = [], tySiblings = Nothing, tyThunk = \
TyNotThunk }
-
-newtype TyEnv = TyEnv (GMap Atom TyTy)
- deriving(Monoid)
-
-
-tagHole = toAtom "@hole"
-
-gEval :: Val -> Exp
-gEval x = BaseOp Eval [x]
-
--- lazy node sptr_t
-tyINode = TyINode
--- strict node wptr_t
-tyDNode = TyNode
-
-
-instance TypeNames Ty where
- tIntzh = TyPrim (Op.bits32)
- tEnumzh = TyPrim (Op.bits16)
- tCharzh = TyPrim (Op.bits32)
-
-data Callable = Continuation | Function | Closure | LocalFunction | Primitive'
- deriving(Eq,Ord,Show)
-
-
-type Tag = Atom
-
-newtype Var = V Int
- deriving(Eq,Ord,Enum)
-
-instance Show Var where
- showsPrec _ (V n) xs = 'v':shows n xs
-
-
-
-{-
-
-data VCont = VCont Val VContext
-
-data VContext = PrimApp PrimApp VCont | Decons Tag Int VCont | ContUnknown
-
-
--}
+-- than examining them. (types may not be constructed at run-time)
infixr 1 :->, :>>=
hunk ./src/Grin/Grin.hs 100
| Promote -- turn an inode into a node, the inode _must_ already \
be a valid node
| Eval -- evaluate an inode, returns a node representing the \
evaluated value. Bool is whether to update the inode
| Apply [Ty] -- apply a partial application to a value, returning the \
given type
- | StoreNode !Bool -- create a new node, Bool is true if it should be an \
direct node, the second val is the region + | StoreNode !Bool -- create a \
new node, Bool is true if it should be a direct node, the second val \
is the region
| Redirect -- write an indirection over its first argument to point \
to its second one
| Overwrite -- overwrite an existing node with new data (the tag \
must match what was used for the initial Store) | PeekVal -- read a \
value from a pointed to location hunk ./src/Grin/Grin.hs 187
| TyUnknown -- ^ an unknown possibly undefined type, All of \
these must be eliminated by code generation deriving(Eq,Ord)
+data Callable = Continuation | Function | Closure | LocalFunction | Primitive'
+ deriving(Eq,Ord,Show)
hunk ./src/Grin/Grin.hs 190
+type Tag = Atom
+
+newtype Var = V Int
+ deriving(Eq,Ord,Enum)
data FuncDef = FuncDef {
funcDefName :: Atom,
hunk ./src/Grin/Grin.hs 202
funcDefProps :: FuncProps
} deriving(Eq,Ord,Show)
+-- Type information table (TyEnv)
+
+data TyThunk
+ = TyNotThunk -- ^ not the thunk
+ | TyPApp (Maybe Ty) Atom -- ^ can be applied to (possibly) an argument, and \
what results + | TySusp Atom -- ^ can be evaluated and calls what \
function + deriving(Eq,Show)
+
+data TyTy = TyTy {
+ tySlots :: [Ty],
+ tyReturn :: [Ty],
+ tyThunk :: TyThunk,
+ tySiblings :: Maybe [Atom]
+}
+
+tyTy = TyTy { tySlots = [], tyReturn = [], tySiblings = Nothing, tyThunk = \
TyNotThunk } +
+newtype TyEnv = TyEnv (GMap Atom TyTy)
+ deriving(Monoid)
+
+-- random utility values
+
+lamExp (_ :-> e) = e
+lamBind (b :-> _) = b
+
+isVar Var {} = True
+isVar _ = False
+
+tagHole = toAtom "@hole"
+
+gEval :: Val -> Exp
+gEval x = BaseOp Eval [x]
+
+tyINode = TyINode -- ^ lazy node sptr_t
+tyDNode = TyNode -- ^ strict node wptr_t
+
createFuncDef local name body@(args :-> rest) = updateFuncDefProps FuncDef { \
funcDefName = name, funcDefBody = body, funcDefCall = call, funcDefProps = funcProps \
} where
call = Item name (TyCall (if local then LocalFunction else Function) (map \
getType args) (getType rest))
hunk ./src/Grin/Grin.hs 241
-
updateFuncDefProps fd@FuncDef { funcDefBody = body@(args :-> rest) } = fd { \
funcDefProps = props } where
props = (funcDefProps fd) { funcFreeVars = freeVars body, funcTags = freeVars \
body, funcType = (map getType args,getType rest) }
hunk ./src/Grin/Grin.hs 248
setGrinFunctions xs _grin | flint && hasRepeatUnder fst xs = error $ \
"setGrinFunctions: grin has redundent definitions" ++ show (fsts xs) \
setGrinFunctions xs grin = grin { grinFunctions = map (uncurry (createFuncDef False)) \
xs }
-
extendTyEnv ds (TyEnv env) = TyEnv (fromList xs `mappend` env) where
xs = [ (funcDefName d,tyTy { tySlots = ss, tyReturn = r }) | d <- ds, let \
(ss,r) = funcType $ funcDefProps d]
++ [ (tagFlipFunction (funcDefName d),tyTy { tySlots = ss, tyReturn = r }) | \
d <- ds, let (ss,r) = funcType $ funcDefProps d, r == [TyNode]] hunk \
./src/Grin/Grin.hs 279 }
-instance Show Ty where
- show TyNode = "N"
- show TyINode = "I"
- show (TyPtr t) = '&':show t
- show (TyUnit) = "()"
- show (TyPrim t) = show t
- show TyRegion = "M"
- show TyGcContext = "GC"
- show (TyRegister t) = 'r':show t
- show (TyCall c as rt) = show c <> tupled (map show as) <+> "->" <+> show rt
- show TyUnknown = "?"
-
-
-instance Show Val where
- -- showsPrec _ s | Just st <- fromVal s = text $ show (st::String)
- showsPrec _ (NodeC t []) = parens $ (fromAtom t)
- showsPrec _ (NodeC t vs) = parens $ (fromAtom t) <+> hsep (map shows vs)
- showsPrec _ (Index v o) = shows v <> char '[' <> shows o <> char ']'
- showsPrec _ (Var (V i) t)
- | TyINode <- t = text "ni" <> tshow i
- | TyNode <- t = text "nd" <> tshow i
- | TyRegion <- t = text "m" <> tshow i
- | TyRegister ty <- t = text "r" <> tshow (Var (V i) ty)
- | TyGcContext <- t = text "gc" <> tshow i
- | TyPtr t' <- t = text "p" <> shows (Var (V i) t')
- | TyPrim Op.TyBool <- t = char 'b' <> tshow i
- | TyPrim (Op.TyBits _ Op.HintFloat) <- t = char 'f' <> tshow i
- | TyPrim (Op.TyBits _ Op.HintCharacter) <- t = char 'c' <> tshow i
- | TyPrim (Op.TyBits (Op.Bits 8) _) <- t = char 'o' <> tshow i -- \
octet
- | TyPrim (Op.TyBits (Op.Bits 16) _) <- t = char 'h' <> tshow i -- half
- | TyPrim (Op.TyBits (Op.Bits 32) _) <- t = char 'w' <> tshow i -- word
- | TyPrim (Op.TyBits (Op.Bits 64) _) <- t = char 'd' <> tshow i -- \
doubleword
- | TyPrim (Op.TyBits (Op.Bits 128) _) <- t = char 'q' <> tshow i -- \
quadword
- | TyPrim (Op.TyBits (Op.BitsArch Op.BitsPtr) _) <- t = text "bp" <> tshow \
i
- | TyPrim (Op.TyBits (Op.BitsArch Op.BitsMax) _) <- t = text "bm" <> tshow \
i
- | TyPrim (Op.TyBits _ _) <- t = char 'l' <> tshow i
- | otherwise = char 'v' <> tshow i
- showsPrec _ (Lit i _) = tshow i
- showsPrec _ Unit = showString "()"
- showsPrec _ (Const v) = char '&' <> shows v
- showsPrec _ (Item a ty) = tshow a <> text "::" <> tshow ty
- showsPrec _ (ValUnknown ty) = text "?::" <> tshow ty
- showsPrec _ (ValPrim aprim xs _) = tshow aprim <> tupled (map tshow xs)
-
data Phase = PhaseInit | PostInlineEval | PostAeOptimize | PostDevolve
deriving(Show,Eq,Ord,Enum)
hunk ./src/Grin/Grin.hs 319
| TagFunc
tagInfo t = case fromAtom t of
- 'F':xs -> TagSusp True (toAtom $ 'f':xs)
- 'B':xs -> TagSusp True (toAtom $ 'b':xs)
+ 'F':xs -> TagSusp True (toAtom $ 'f':xs)
+ 'B':xs -> TagSusp True (toAtom $ 'b':xs)
'f':_ -> TagFunc
'b':_ -> TagFunc
hunk ./src/Grin/Grin.hs 323
+ 'C':_ -> TagDataCons
+ 'T':_ -> TagTypeCons
'P':is | (n@(_:_),('_':xs)) <- span isDigit is -> TagPApp (read n) (toAtom $ \
'f':xs)
'Y':is | (n@(_:_),('_':xs)) <- span isDigit is -> TagTypePApp (read n) (toAtom $ \
'T':xs) hunk ./src/Grin/Grin.hs 327
- 'C':_ -> TagDataCons
- 'T':_ -> TagTypeCons
t -> error $ "tagInfo: bad tag " ++ t
hunk ./src/Grin/Grin.hs 329
-
partialTag :: Tag -> Int -> Tag
partialTag v c = case fromAtom v of
('f':xs) | 0 <- c -> toAtom $ 'F':xs
hunk ./src/Grin/Grin.hs 338
('b':xs) | 0 <- c -> toAtom $ 'B':xs
_ -> error $ "partialTag: " ++ show (v,c)
-
-
tagUnfunction :: Monad m => Tag -> m (Int, Tag)
tagUnfunction t
| tagIsSuspFunction t = return (0,tagFlipFunction t)
hunk ./src/Grin/Grin.hs 346
where t' = fromAtom t
tagUnfunction _ = fail "Tag does not represent function"
-
-
tagFlipFunction t
| 'F':xs <- t' = toAtom $ 'f':xs
| 'B':xs <- t' = toAtom $ 'b':xs
hunk ./src/Grin/Grin.hs 413
isValUnknown ValUnknown {} = True
isValUnknown _ = False
-
---------
-- Look up stuff in the typing environment.
---------
hunk ./src/Grin/Grin.hs 445
p2 = Var v2 TyINode
p3 = Var v3 TyINode
+-- CanType instances
instance CanType Exp [Ty] where
getType (_ :>>= (_ :-> e2)) = getType e2
hunk ./src/Grin/Grin.hs 491
getType (ValUnknown ty) = ty
getType (Item _ ty) = ty
+-- FreeVars instances
+
instance FreeVars Lam (Set.Set Var) where
freeVars (x :-> y) = freeVars y Set.\\ freeVars x
instance FreeVars Lam (Set.Set (Var,Ty)) where
hunk ./src/Grin/Grin.hs 665
freeVars MkCont { expCont = v, expLam = as} = freeVars (v,as)
freeVars GcRoots { expValues = v, expBody = b } = freeVars (v,b)
-lamExp (_ :-> e) = e
-lamBind (b :-> _) = b
+-- Show instances
hunk ./src/Grin/Grin.hs 667
-isVar Var {} = True
-isVar _ = False
+instance Show Var where
+ showsPrec _ (V n) xs = 'v':shows n xs
+
+instance Show Ty where
+ show TyNode = "N"
+ show TyINode = "I"
+ show (TyPtr t) = '&':show t
+ show (TyUnit) = "()"
+ show (TyPrim t) = show t
+ show TyRegion = "M"
+ show TyGcContext = "GC"
+ show (TyRegister t) = 'r':show t
+ show (TyCall c as rt) = show c <> tupled (map show as) <+> "->" <+> show rt
+ show TyUnknown = "?"
+
+
+instance Show Val where
+ -- showsPrec _ s | Just st <- fromVal s = text $ show (st::String)
+ showsPrec _ (NodeC t []) = parens $ (fromAtom t)
+ showsPrec _ (NodeC t vs) = parens $ (fromAtom t) <+> hsep (map shows vs)
+ showsPrec _ (Index v o) = shows v <> char '[' <> shows o <> char ']'
+ showsPrec _ (Var (V i) t)
+ | TyINode <- t = text "ni" <> tshow i
+ | TyNode <- t = text "nd" <> tshow i
+ | TyRegion <- t = text "m" <> tshow i
+ | TyRegister ty <- t = text "r" <> tshow (Var (V i) ty)
+ | TyGcContext <- t = text "gc" <> tshow i
+ | TyPtr t' <- t = text "p" <> shows (Var (V i) t')
+ | TyPrim Op.TyBool <- t = char 'b' <> tshow i
+ | TyPrim (Op.TyBits _ Op.HintFloat) <- t = char 'f' <> tshow i
+ | TyPrim (Op.TyBits _ Op.HintCharacter) <- t = char 'c' <> tshow i
+ | TyPrim (Op.TyBits (Op.Bits 8) _) <- t = char 'o' <> tshow i -- \
octet + | TyPrim (Op.TyBits (Op.Bits 16) _) <- t = char 'h' <> tshow i \
-- half + | TyPrim (Op.TyBits (Op.Bits 32) _) <- t = char 'w' <> tshow i \
-- word + | TyPrim (Op.TyBits (Op.Bits 64) _) <- t = char 'd' <> tshow i \
-- doubleword + | TyPrim (Op.TyBits (Op.Bits 128) _) <- t = char 'q' <> \
tshow i -- quadword + | TyPrim (Op.TyBits (Op.BitsArch Op.BitsPtr) _) <- t \
= text "bp" <> tshow i + | TyPrim (Op.TyBits (Op.BitsArch Op.BitsMax) _) <- t \
= text "bm" <> tshow i + | TyPrim (Op.TyBits _ _) <- t = char 'l' <> tshow i
+ | otherwise = char 'v' <> tshow i
+ showsPrec _ (Lit i _) = tshow i
+ showsPrec _ Unit = showString "()"
+ showsPrec _ (Const v) = char '&' <> shows v
+ showsPrec _ (Item a ty) = tshow a <> text "::" <> tshow ty
+ showsPrec _ (ValUnknown ty) = text "?::" <> tshow ty
+ showsPrec _ (ValPrim aprim xs _) = tshow aprim <> tupled (map tshow xs)
+
+-- misc instances
+
+instance TypeNames Ty where
+ tIntzh = TyPrim (Op.bits32)
+ tEnumzh = TyPrim (Op.bits16)
+ tCharzh = TyPrim (Op.bits32)
instance Intjection Var where
hunk ./src/Grin/Optimize.hs 1
-
module Grin.Optimize(grinPush,grinSpeculate) where
import Control.Monad.State
hunk ./src/Grin/Optimize.hs 7
import List
import qualified Data.Set as Set
-import StringTable.Atom
import C.Prims
import Grin.Grin
import Grin.Noodle
hunk ./src/Grin/Optimize.hs 10
+import Options (verbose)
import Stats hiding(null,isEmpty)
hunk ./src/Grin/Optimize.hs 12
+import StringTable.Atom
import Support.CanType
import Support.FreeVars
hunk ./src/Grin/Optimize.hs 15
-import Util.HasSize
import Util.GMap
import Util.Graph
hunk ./src/Grin/Optimize.hs 17
+import Util.HasSize
import Util.SetLike
hunk ./src/Grin/Optimize.hs 19
-import Options (verbose)
data PExp = PExp {
pexpUniq :: Int,
hunk ./src/Grin/Optimize.hs 168
-- v <- prefer exp
-- return [ p | p <- pexps, v == pexpBind p]
-
-
grinSpeculate :: Grin -> IO Grin
grinSpeculate grin = do
let ss = findSpeculatable grin
hunk ./src/Grin/Optimize.hs 177
when verbose $ Stats.printStat "Speculate" stats
return grin'
-
performSpeculate specs grin = do
let sset = fromList (map tagFlipFunction specs) :: GSet Tag
let f (a,l) = mapBodyM h l >>= \l' -> return (a,l')
hunk ./src/Grin/Optimize.hs 205
isSpeculatable _ = False
demote x = BaseOp Demote [x]
-
-
-
Context:
[remove old Grin.Simplify module
John Meacham <john@repetae.net>**20110129225838
Ignore-this: 5dcd84e57bfe1459fbd695955e763ee6
]
[add no-strict-aliasing flag to gcc options
John Meacham <john@repetae.net>**20110129225335
Ignore-this: 2ef5b854c51eafab24f366f3eb1adc19
]
[add Rand.hs to regression tests for WRAPPER bug fix
John Meacham <john@repetae.net>**20110129222922
Ignore-this: 28ebf4405feee143b6300ba1518add13
]
[fix bug that would sometimes keep WRAPPERs from being inlined, dramatically speeds \
up some tests. John Meacham <john@repetae.net>**20110126214144
Ignore-this: aa74f39e44d03cdbd2d36a8e5b3eefa9
]
[print out core when dumping libraries
John Meacham <john@repetae.net>**20110126205030
Ignore-this: c4029042b522b8ee6234939535193d4b
]
[fix argument order for shiftL/R instances
John Meacham <john@repetae.net>**20110123033306
Ignore-this: 8bbe427609b45be012cf678c25a76ef
]
[We want to inline generated wrappers even when user's inline PRAGMAs are disabled.
John Meacham <john@repetae.net>**20110123021358
Ignore-this: bc2f5e23d780ae328980d3027f444137
]
[code cleanups
John Meacham <john@repetae.net>**20110123020827
Ignore-this: baa775db670d36fb727ee8ac079d6cfb
]
[pre-initialize GC caches to avoid check in allocator gaining a couple percent in \
speed. John Meacham <john@repetae.net>**20101207121705
Ignore-this: 1e00392ff635becfb744d56d0a363a7f
]
[don't increment allocation count when we arn't using it for status updates.
John Meacham <john@repetae.net>**20101207050322
Ignore-this: f5209ab8f28a19f301d0dc9a7d1539ec
]
[remove quadratic behavior in programSetDs'
John Meacham <john@repetae.net>**20101207033358
Ignore-this: d0a52945b310e2a599cc54510c18ea5b
]
[fix bug where the static argument transformation would clear rules. clean up a lot \
of code. John Meacham <john@repetae.net>**20101207031557
Ignore-this: a78a8819ac6728d331b9a01e9a665152
]
[clean ups and remove unused module, make selftest work with the new ghc
John Meacham <john@repetae.net>**20101206122555
Ignore-this: 5b56d3dcd7186aeab6e3b42c57db0f99
]
[fix type checker bug that occasionally reported false erros
John Meacham <john@repetae.net>**20101206120451
Ignore-this: a34be6e294bde1e95ad7a9ca35b42055
]
[fix pretty printing fixity of core to reduce ambiguity
John Meacham <john@repetae.net>**20101204231805
Ignore-this: 8adc87b15e09134f673da1b438adc5a2
]
[Fix a lot of compiler warnings, clean up dependencies.
John Meacham <john@repetae.net>**20101204035931
Ignore-this: 7524be06d3ca6cd957316e50451b7208
]
[show text of exception when dumping core.
John Meacham <john@repetae.net>**20100826091509
Ignore-this: 859d57d2a6184698e97f0083482b3039
]
[remove ePrettyEx
John Meacham <john@repetae.net>**20100812102458
Ignore-this: 5ff9ed89d829f656c11012d75bab6f16
]
[clean up warnings
John Meacham <john@repetae.net>**20100812102435
Ignore-this: 582526a443397ee875d3530d892b704d
]
[clean up E showing, get rid of -dhtml mode, get rid of ANSI color coding, dump \
jhc_core to files on error John Meacham <john@repetae.net>**20100812101452
Ignore-this: ef81f8c50892ecfdda3b5a450d8fbac0
]
[when let-shrinking a tail, be sure to optimize function bodies
John Meacham <john@repetae.net>**20100812054500
Ignore-this: eb1b56f28287a98b67bcd9c29d50ba82
]
[improve Grin Linting a little
John Meacham <john@repetae.net>**20100812054446
Ignore-this: c7613a94c296e089a985904aa049d002
]
[add imported ghc typechecking regression tests
John Meacham <john@repetae.net>**20100811014451
Ignore-this: 7f625abf2f8d562bc76b71396a7e03f0
]
[import ghc parsing regression tests
John Meacham <john@repetae.net>**20100811002607
Ignore-this: 7a3676c7655fe26c52dd7eddd3c356dc
]
[add 'skip' to regression options to skip certain tests
John Meacham <john@repetae.net>**20100811002445
Ignore-this: 261b5e51fa22d7af25989ee078853590
]
[allow unicode characters in haskell source
John Meacham <john@repetae.net>**20100810233304
Ignore-this: dd54c632455bd0660ff7b5170d81c8ed
]
[add regex-compat to dependencies
John Meacham <john@repetae.net>**20100810230216
Ignore-this: e7c03b8e187802ab75dbcc574614eabc
]
[accept empty class contexts
John Meacham <john@repetae.net>**20100810063832
Ignore-this: 9dea1ec61b874fcb3537b79b74b345df
]
[add 'transformers' package to included libraries
John Meacham <john@repetae.net>**20100810054906
Ignore-this: e27f376331b3fac2e3414145bf17a1c0
]
[fix desugaring of irrefutable lambda bindings
John Meacham <john@repetae.net>**20100810053944
Ignore-this: 5c70934cbe42169850481562cd5b20f3
]
[add some strictness annotations
John Meacham <john@repetae.net>**20100810053827
Ignore-this: 15ed2e2fc90656cc418a841848e43107
]
[clean ups
John Meacham <john@repetae.net>**20100806112820
Ignore-this: 64c0ae0922073b65fc0dac4bd35ba968
]
[speed up name choosing a little
John Meacham <john@repetae.net>**20100806111703
Ignore-this: ac159eeb0d34a7d26ad74253d00386ae
]
[further seperate out concrete types to speed up checking
John Meacham <john@repetae.net>**20100806092815
Ignore-this: f992ced583042d3c7797d4de93e3e3a8
]
[split type environment into concrete and mutable sets, to avoid retraversing the \
concrete imported types John Meacham <john@repetae.net>**20100806090349
Ignore-this: c276618b4b968d9149e6b3dfc36d162a
]
[create a better relation representation, speed up export chasing signifigantly
John Meacham <john@repetae.net>**20100806082622
Ignore-this: 9f49871e33348bbfc4e8fd2ee9fa71b8
]
[fix a few minor bugs in libraries found by better error reporting
John Meacham <john@repetae.net>**20100806045809
Ignore-this: e7d43927c9e11b05de455a5d0ebd1017
]
[check export lists for unknown names
John Meacham <john@repetae.net>**20100806045759
Ignore-this: 4b3ff8381117f2acae34dd6b936c8e8d
]
[ret rid of seperate subtable and errortable in favor of unified namemap
John Meacham <john@repetae.net>**20100806032455
Ignore-this: 9e8fbd31f988d77614bd49fc23cefae
]
[treat () the same as tuples when renaming
John Meacham <john@repetae.net>**20100806023948
Ignore-this: defa66a11f1081a4582a5301cff217e4
]
[move selector creation from desugar to renamer, detect multiply defined top level \
values and report an error properly. John Meacham <john@repetae.net>**20100806021241
Ignore-this: 507bce69ec8ffe0085c3a72ffc0ec571
]
[add initial version of jhc-prim
John Meacham <john@repetae.net>**20100806000900
Ignore-this: 44a9f14db168b28d731fd750bba0fee9
]
[clean up preprocessing a little
John Meacham <john@repetae.net>**20100803073754
Ignore-this: c1064468bed864231c2d5fb3a68bbeaf
]
[utilize preprocessor rather than ./configure to handle System.Info
John Meacham <john@repetae.net>**20100802100036
Ignore-this: 76681affa5b0269621974deeccda019b
]
[fix some warnings
John Meacham <john@repetae.net>**20100801083507
Ignore-this: fd350fd02d0ad5a611ee1811de28bce5
]
[fix build problem for tarball
John Meacham <john@repetae.net>**20100801082137
Ignore-this: 33671b52398eef61afa670eb031ef575
]
[update strictness and UNPACK annotations
John Meacham <john@repetae.net>**20100801080035
Ignore-this: e598a6098143c1a62373a443865b3cfb
]
[add announcement for 0.7.6
John Meacham <john@repetae.net>**20100731111353
Ignore-this: 111c27548d94bdfe0042d61b02fe5728
]
[TAG 0.7.6
John Meacham <john@repetae.net>**20100731104908
Ignore-this: d5edc6edd6d300cbae451f0e056ee018
]
Patch bundle hash:
46059ea6c07afd149f5cf20b36b3291aa6d6494b
_______________________________________________
jhc mailing list
jhc@haskell.org
http://www.haskell.org/mailman/listinfo/jhc
.
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic