summaryrefslogtreecommitdiff
path: root/ghc/compiler/hsSyn
Commit message (Collapse)AuthorAgeFilesLines
* [project @ 2001-05-01 09:16:55 by qrczak]qrczak2001-05-011-11/+1
| | | | | Inline instance dictionary functions. Remove {-# INLINE instance #-} support and uses.
* [project @ 2001-04-30 08:26:54 by simonpj]simonpj2001-04-301-7/+7
| | | | Improve error message
* [project @ 2001-04-14 22:24:24 by qrczak]qrczak2001-04-141-2/+12
| | | | | Add {-# INLINE instance #-} pragma which ensures that the dictionary function is inlined.
* [project @ 2001-03-27 14:05:09 by simonpj]simonpj2001-03-272-11/+16
| | | | Print minimal import operators correctly
* [project @ 2001-03-13 15:53:52 by simonmar]simonmar2001-03-131-3/+1
| | | | unused imports
* [project @ 2001-03-13 14:58:25 by simonpj]simonpj2001-03-131-13/+13
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | ---------------- Nuke ClassContext ---------------- This commit tidies up a long-standing inconsistency in GHC. The context of a class or instance decl used to be restricted to predicates of the form C t1 .. tn with type ClassContext = [(Class,[Type])] but everywhere else in the compiler we used type ThetaType = [PredType] where PredType can be any sort of constraint (= predicate). The inconsistency actually led to a crash, when compiling class (?x::Int) => C a where {} I've tidied all this up by nuking ClassContext altogether, and using PredType throughout. Lots of modified files, but all in more-or-less trivial ways. I've also added a check that the context of a class or instance decl doesn't include a non-inheritable predicate like (?x::Int). Other things * rename constructor 'Class' from type TypeRep.Pred to 'ClassP' (makes it easier to grep for) * rename constructor HsPClass => HsClassP HsPIParam => HsIParam
* [project @ 2001-03-13 12:50:29 by simonmar]simonmar2001-03-131-4/+6
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Some rearrangements that Simon & I have been working on recently: - CoreSat is now CorePrep, and is a general "prepare-for-code- generation" pass. It does cloning, saturation of constructors & primops, A-normal form, and a couple of other minor fiddlings. - CoreTidy no longer does cloning, and minor fiddlings. It doesn't need the unique supply any more, so that's removed. - CoreToStg now collects CafInfo and the list of CafRefs for each binding. The SRT pass is much simpler now. - IdInfo now has a CgInfo field for "code generator info". It currently contains arity (the actual code gen arity which affects the calling convention as opposed to the ArityInfo which is a measure of how many arguments the Id can be applied to before it does any work), and CafInfo. Previously we overloaded the ArityInfo field to contain both codegen arity and simplifier arity. Things are cleaner now. - CgInfo is collected by CoreToStg, and passed back into CoreTidy in a loop. The compiler will complain rather than going into a black hole if the CgInfo is pulled on too early. - Worker info in an interface file now comes with arity info attached. Previously the main arity info was overloaded for this purpose, but it lead to a few hacks in the compiler, this tidies things up somewhat. Bottom line: we removed several fragilities, and tidied up a number of things. Code size should be smaller, but we'll see...
* [project @ 2001-02-26 15:06:57 by simonmar]simonmar2001-02-266-53/+249
| | | | | | | | | | | | | | | | | Implement do-style bindings on the GHCi command line. The syntax for a command-line is exactly that of a do statement, with the following meanings: - `pat <- expr' performs expr, and binds each of the variables in pat. - `let pat = expr; ...' binds each of the variables in pat, doesn't do any evaluation - `expr' behaves as `it <- expr' if expr is IO-typed, or `let it = expr' followed by `print it' otherwise.
* [project @ 2001-02-20 09:40:43 by simonpj]simonpj2001-02-203-28/+21
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Decoupling the Prelude [HsExpr, HsLit, HsPat, ParseUtil, Parser.y, PrelNames, ~~~~~~~~~~~~~~~~~~~~~~ Rename, RnEnv, RnExpr, RnHsSyn, Inst, TcEnv, TcMonad, TcPat, TcExpr] The -fno-implicit-prelude flag is meant to arrange that when you write 3 you get fromInt 3 where 'fromInt' is whatever fromInt is in scope at the top level of the module being compiled. Similarly for * numeric patterns * n+k patterns * negation This used to work, but broke when we made the static/dynamic flag distinction. It's now tidied up a lot. Here's the plan: - PrelNames contains sugarList :: SugarList, which maps built-in names to the RdrName that should replace them. - The renamer makes a finite map :: SugarMap, which maps the built-in names to the Name of the re-mapped thing - The typechecker consults this map via tcLookupSyntaxId when it is doing numeric things At present I've only decoupled numeric syntax, since that is the main demand, but the scheme is much more robustly extensible than the previous method. As a result some HsSyn constructors don't need to carry names in them (notably HsOverLit, NegApp, NPlusKPatIn)
* [project @ 2001-01-25 17:41:33 by simonpj]simonpj2001-01-251-2/+1
| | | | Improve printing
* [project @ 2001-01-11 13:58:05 by simonpj]simonpj2001-01-111-1/+3
| | | | | | | | | | | | | | | | | | | Fix a grotesque bug in the HsCore.pprUfExpr The expression ((\x -> f x y) a b) printed as (\x -> f x y a b) which in turn caused any importing module to behave most oddly. This didn't show up before, because such expressions don't happen much (they are simplified). But one showed up in a RULE (which happens to be simplified only very gently), and that tickled this bug.
* [project @ 2001-01-03 11:18:51 by simonmar]simonmar2001-01-031-3/+3
| | | | | | | | | | | | | s/boxed/lifted/ The typechecker's notion of "boxed" versus "unboxed" kind should really have been "unlifted" versus "lifted" instead. It is illegal to unify an unlifted (but boxed) type with a polymorphic type variable, since an unlifted/boxed type is always assumed to be a pointer to the object itself, never a thunk or indirection. This commit removes isUnboxedType, and renames a bunch of things that were previously boxed/unboxed to unlifted/lifted.
* [project @ 2000-12-20 11:02:17 by simonpj]simonpj2000-12-202-19/+104
| | | | Add comments and tidy
* [project @ 2000-12-19 17:32:44 by simonpj]simonpj2000-12-191-1/+1
| | | | Mainly rename rnDecl to rnSourceDecl; and add more tracing to renamer
* [project @ 2000-12-07 08:26:47 by simonpj]simonpj2000-12-072-9/+14
| | | | Better handling of HsTupCon (tidy up + fix minor versioning bug)
* [project @ 2000-12-01 13:42:52 by simonpj]simonpj2000-12-011-1/+1
| | | | Towards better eta expansion
* [project @ 2000-11-27 16:10:29 by simonpj]simonpj2000-11-271-4/+3
| | | | Get default methods right
* [project @ 2000-11-27 11:04:38 by simonpj]simonpj2000-11-271-2/+3
| | | | Default methods are sys-binders
* [project @ 2000-11-24 17:02:01 by simonpj]simonpj2000-11-242-110/+120
| | | | | | | | | | | | | 1. Make the new version machinery work. I think it does now! 2. Consequence of (1): Move the generation of default method names to one place (namely in RdrHsSyn.mkClassOpSigDM 3. Major clean up on HsDecls.TyClDecl These big constructors should have been records ages ago, and they are now. At last.
* [project @ 2000-11-20 16:07:12 by simonpj]simonpj2000-11-201-1/+14
| | | | Remember local decls when no recompilation is required
* [project @ 2000-11-20 14:48:52 by simonpj]simonpj2000-11-201-1/+0
| | | | | | | | | | When renaming, typechecking an expression from the user interface, we may suck in declarations from interface files (e.g. the Prelude). This commit takes account of that. To do so, I did some significant restructuring in TcModule, with consequential changes and tidy ups elsewhere in the type checker. I think there should be fewer lines in total than before.
* [project @ 2000-11-14 08:07:11 by simonpj]simonpj2000-11-142-6/+5
| | | | | | | | | Changing the way we know whether something is exported. THIS COMMIT WON'T EVEN COMPILE (I'm doing it to transfer from my laptop.) Wait till later today before updating.
* [project @ 2000-11-10 15:12:50 by simonpj]simonpj2000-11-102-9/+10
| | | | | | | | | | | | | | 1. Outputable.PprStyle now carries a bit more information In particular, the printing style tells whether to print a name in unqualified form. This used to be embedded in a Name, but since Names now outlive a single compilation unit, that's no longer appropriate. So now the print-unqualified predicate is passed in the printing style, not embedded in the Name. 2. I tidied up HscMain a little. Many of the showPass messages have migraged into the repective pass drivers
* [project @ 2000-11-07 15:21:38 by simonmar]simonmar2000-11-075-105/+165
| | | | | | This commit completes the merge of compiler part of the HEAD with the before-ghci-branch to before-ghci-branch-merged.
* [project @ 2000-11-07 13:12:21 by simonpj]simonpj2000-11-072-8/+17
| | | | More small changes
* [project @ 2000-10-30 13:46:24 by sewardj]sewardj2000-10-302-1/+7
| | | | | Only pass a ModuleLocation into hscMain, not a ModSummary, so as to facilitate Main.main not necessarily being in Main.hs.
* [project @ 2000-10-30 09:52:14 by simonpj]simonpj2000-10-301-5/+5
| | | | First steps to making it work
* [project @ 2000-10-25 12:56:20 by simonpj]simonpj2000-10-252-29/+26
| | | | Tons of stuff for the mornings work
* [project @ 2000-10-25 07:09:52 by simonpj]simonpj2000-10-252-6/+10
| | | | More renamer stuff; still in flight
* [project @ 2000-10-24 15:55:35 by simonpj]simonpj2000-10-242-31/+18
| | | | More renamer
* [project @ 2000-10-24 07:35:35 by simonpj]simonpj2000-10-241-23/+0
| | | | Remove HsPragmas; hasnt been used for ages
* [project @ 2000-10-24 07:35:00 by simonpj]simonpj2000-10-245-142/+129
| | | | Mainly MkIface
* [project @ 2000-10-23 09:03:26 by simonpj]simonpj2000-10-234-16/+7
| | | | Mainly renamer
* [project @ 2000-10-12 15:17:55 by simonmar]simonmar2000-10-121-1/+2
| | | | isUnboundName moved
* [project @ 2000-10-12 11:32:33 by sewardj]sewardj2000-10-122-6/+6
| | | | Propagate recent changes in module/Module.lhs.
* [project @ 2000-10-03 08:43:00 by simonpj]simonpj2000-10-037-53/+119
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | -------------------------------------- Adding generics SLPJ Oct 2000 -------------------------------------- This big commit adds Hinze/PJ-style generic class definitions, based on work by Andrei Serjantov. For example: class Bin a where toBin :: a -> [Int] fromBin :: [Int] -> (a, [Int]) toBin {| Unit |} Unit = [] toBin {| a :+: b |} (Inl x) = 0 : toBin x toBin {| a :+: b |} (Inr y) = 1 : toBin y toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y fromBin {| Unit |} bs = (Unit, bs) fromBin {| a :+: b |} (0:bs) = (Inl x, bs') where (x,bs') = fromBin bs fromBin {| a :+: b |} (1:bs) = (Inr y, bs') where (y,bs') = fromBin bs fromBin {| a :*: b |} bs = (x :*: y, bs'') where (x,bs' ) = fromBin bs (y,bs'') = fromBin bs' Now we can say simply instance Bin a => Bin [a] and the compiler will derive the appropriate code automatically. (About 9k lines of diffs. Ha!) Generic related things ~~~~~~~~~~~~~~~~~~~~~~ * basicTypes/BasicTypes: The EP type (embedding-projection pairs) * types/TyCon: An extra field in an algebraic tycon (genInfo) * types/Class, and hsSyn/HsBinds: Each class op (or ClassOpSig) carries information about whether it a) has no default method b) has a polymorphic default method c) has a generic default method There's a new data type for this: Class.DefMeth * types/Generics: A new module containing good chunk of the generic-related code It has a .hi-boot file (alas). * typecheck/TcInstDcls, typecheck/TcClassDcl: Most of the rest of the generics-related code * hsSyn/HsTypes: New infix type form to allow types of the form data a :+: b = Inl a | Inr b * parser/Parser.y, Lex.lhs, rename/ParseIface.y: Deal with the new syntax * prelude/TysPrim, TysWiredIn: Need to generate generic stuff for the wired-in TyCons * rename/RnSource RnBinds: A rather gruesome hack to deal with scoping of type variables from a generic patterns. Details commented in the ClassDecl case of RnSource.rnDecl. Of course, there are many minor renamer consequences of the other changes above. * lib/std/PrelBase.lhs Data type declarations for Unit, :+:, :*: Slightly unrelated housekeeping ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ * hsSyn/HsDecls: ClassDecls now carry the Names for their implied declarations (superclass selectors, tycon, etc) in a list, rather than laid out one by one. This simplifies code between the parser and the type checker. * prelude/PrelNames, TysWiredIn: All the RdrNames are now together in PrelNames. * utils/ListSetOps: Add finite mappings based on equality and association lists (Assoc a b) Move stuff from List.lhs that is related
* [project @ 2000-09-28 15:15:48 by simonpj]simonpj2000-09-281-1/+1
| | | | Wibbles
* [project @ 2000-09-28 13:04:14 by simonpj]simonpj2000-09-282-5/+4
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | ------------------------------------ Mainly PredTypes (28 Sept 00) ------------------------------------ Three things in this commit: 1. Main thing: tidy up PredTypes 2. Move all Keys into PrelNames 3. Check for unboxed tuples in function args 1. Tidy up PredTypes ~~~~~~~~~~~~~~~~~~~~ The main thing in this commit is to modify the representation of Types so that they are a (much) better for the qualified-type world. This should simplify Jeff's life as he proceeds with implicit parameters and functional dependencies. In particular, PredType, introduced by Jeff, is now blessed and dignified with a place in TypeRep.lhs: data PredType = Class Class [Type] | IParam Name Type Consider these examples: f :: (Eq a) => a -> Int g :: (?x :: Int -> Int) => a -> Int h :: (r\l) => {r} => {l::Int | r} Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates*, and are represented by a PredType. (We don't support TREX records yet, but the setup is designed to expand to allow them.) In addition, Type gains an extra constructor: data Type = .... | PredTy PredType so that PredType is injected directly into Type. So the type p => t is represented by PredType p `FunTy` t I have deleted the hackish IPNote stuff; predicates are dealt with entirely through PredTys, not through NoteTy at all. 2. Move Keys into PrelNames ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ This is just a housekeeping operation. I've moved all the pre-assigned Uniques (aka Keys) from Unique.lhs into PrelNames.lhs. I've also moved knowKeyRdrNames from PrelInfo down into PrelNames. This localises in PrelNames lots of stuff about predefined names. Previously one had to alter three files to add one, now only one. 3. Unboxed tuples ~~~~~~~~~~~~~~~~~~ Add a static check for unboxed tuple arguments. E.g. data T = T (# Int, Int #) is illegal
* [project @ 2000-09-22 16:00:08 by simonpj]simonpj2000-09-222-72/+81
| | | | Forgot to remove HsBasic and add HsLit
* [project @ 2000-09-22 15:56:12 by simonpj]simonpj2000-09-224-73/+57
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | -------------------------------------------------- Tidying up HsLit, and making it possible to define your own numeric library Simon PJ 22 Sept 00 -------------------------------------------------- ** NOTE: I did these changes on the aeroplane. They should compile, and the Prelude still compiles OK, but it's entirely possible that I've broken something The original reason for this many-file but rather shallow commit is that it's impossible in Haskell to write your own numeric library. Why? Because when you say '1' you get (Prelude.fromInteger 1), regardless of what you hide from the Prelude, or import from other libraries you have written. So the idea is to extend the -fno-implicit-prelude flag so that in addition to no importing the Prelude, you can rebind fromInteger -- Applied to literal constants fromRational -- Ditto negate -- Invoked by the syntax (-x) the (-) used when desugaring n+k patterns After toying with other designs, I eventually settled on a simple, crude one: rather than adding a new flag, I just extended the semantics of -fno-implicit-prelude so that uses of fromInteger, fromRational and negate are all bound to "whatever is in scope" rather than "the fixed Prelude functions". So if you say {-# OPTIONS -fno-implicit-prelude #-} module M where import MyPrelude( fromInteger ) x = 3 the literal 3 will use whatever (unqualified) "fromInteger" is in scope, in this case the one gotten from MyPrelude. On the way, though, I studied how HsLit worked, and did a substantial tidy up, deleting quite a lot of code along the way. In particular. * HsBasic.lhs is renamed HsLit.lhs. It defines the HsLit type. * There are now two HsLit types, both defined in HsLit. HsLit for non-overloaded literals (like 'x') HsOverLit for overloaded literals (like 1 and 2.3) * HsOverLit completely replaces Inst.OverloadedLit, which disappears. An HsExpr can now be an HsOverLit as well as an HsLit. * HsOverLit carries the Name of the fromInteger/fromRational operation, so that the renamer can help with looking up the unqualified name when -fno-implicit-prelude is on. Ditto the HsExpr for negation. It's all very tidy now. * RdrHsSyn contains the stuff that handles -fno-implicit-prelude (see esp RdrHsSyn.prelQual). RdrHsSyn also contains all the "smart constructors" used by the parser when building HsSyn. See for example RdrHsSyn.mkNegApp (previously the renamer (!) did the business of turning (- 3#) into -3#). * I tidied up the handling of "special ids" in the parser. There's much less duplication now. * Move Sven's Horner stuff to the desugarer, where it belongs. There's now a nice function DsUtils.mkIntegerLit which brings together related code from no fewer than three separate places into one single place. Nice! * A nice tidy-up in MatchLit.partitionEqnsByLit became possible. * Desugaring of HsLits is now much tidier (DsExpr.dsLit) * Some stuff to do with RdrNames is moved from ParseUtil.lhs to RdrHsSyn.lhs, which is where it really belongs. * I also removed many unnecessary imports from modules quite a bit of dead code in divers places
* [project @ 2000-09-14 13:46:39 by simonpj]simonpj2000-09-142-17/+2
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | --------------------------------------- Simon's tuning changes: early Sept 2000 --------------------------------------- Library changes ~~~~~~~~~~~~~~~ * Eta expand PrelShow.showLitChar. It's impossible to compile this well, and it makes a big difference to some programs (e.g. gen_regexps) * Make PrelList.concat into a good producer (in the foldr/build sense) Flag changes ~~~~~~~~~~~~ * Add -ddump-hi-diffs to print out changes in interface files. Useful when watching what the compiler is doing * Add -funfolding-update-in-place to enable the experimental optimisation that makes the inliner a bit keener to inline if it's in the RHS of a thunk that might be updated in place. Sometimes this is a bad idea (one example is in spectral/sphere; see notes in nofib/Simon-nofib-notes) Tuning things ~~~~~~~~~~~~~ * Fix a bug in SetLevels.lvlMFE. (change ctxt_lvl to dest_level) I don't think this has any performance effect, but it saves making a redundant let-binding that is later eliminated. * Desugar.dsProgram and DsForeign Glom together all the bindings into a single Rec. Previously the bindings generated by 'foreign' declarations were not glommed together, but this led to an infelicity (i.e. poorer code than necessary) in the modules that actually declare Float and Double (explained a bit more in Desugar.dsProgram) * OccurAnal.shortMeOut and IdInfo.shortableIdInfo Don't do the occurrence analyser's shorting out stuff for things which have rules. Comments near IdInfo.shortableIdInfo. This is deeply boring, and mainly to do with making rules work well. Maybe rules should have phases attached too.... * CprAnalyse.addIdCprInfo Be a bit more willing to add CPR information to thunks; in particular, if the strictness analyser has just discovered that this is a strict let, then the let-to-case transform will happen, and CPR is fine. This made a big difference to PrelBase.modInt, which had something like modInt = \ x -> let r = ... -> I# v in ...body strict in r... r's RHS isn't a value yet; but modInt returns r in various branches, so if r doesn't have the CPR property then neither does modInt * MkId.mkDataConWrapId Arrange that vanilla constructors, like (:) and I#, get unfoldings that are just a simple variable $w:, $wI#. This ensures they'll be inlined even into rules etc, which makes matching a bit more reliable. The downside is that in situations like (map (:) xs), we'll end up with (map (\y ys. $w: y ys) xs. Which is tiresome but it doesn't happen much. * SaAbsInt.findStrictness Deal with the case where a thing with no arguments is bottom. This is Good. E.g. module M where { foo = error "help" } Suppose we have in another module case M.foo of ... Then we'd like to do the case-of-error transform, without inlining foo. Tidying up things ~~~~~~~~~~~~~~~~~ * Reorganised Simplify.completeBinding (again). * Removed the is_bot field in CoreUnfolding (is_cheap is true if is_bot is!) This is just a tidy up * HsDecls and others Remove the NewCon constructor from ConDecl. It just added code, and nothing else. And it led to a bug in MkIface, which though that a newtype decl was always changing! * IdInfo and many others Remove all vestiges of UpdateInfo (hasn't been used for years)
* [project @ 2000-08-07 23:37:19 by qrczak]qrczak2000-08-072-8/+8
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Now Char, Char#, StgChar have 31 bits (physically 32). "foo"# is still an array of bytes. CharRep represents 32 bits (on a 64-bit arch too). There is also Int8Rep, used in those places where bytes were originally meant. readCharArray, indexCharOffAddr etc. still use bytes. Storable and {I,M}Array use wide Chars. In future perhaps all sized integers should be primitive types. Then some usages of indexing primops scattered through the code could be changed to then-available Int8 ones, and then Char variants of primops could be made wide (other usages that handle text should use conversion that will be provided later). I/O and _ccall_ arguments assume ISO-8859-1. UTF-8 is internally used for string literals (only). Z-encoding is ready for Unicode identifiers. Ranges of intlike and charlike closures are more easily configurable. I've probably broken nativeGen/MachCode.lhs:chrCode for Alpha but I don't know the Alpha assembler to fix it (what is zapnot?). Generally I'm not sure if I've done the NCG changes right. This commit breaks the binary compatibility (of course). TODO: * is* and to{Lower,Upper} in Char (in progress). * Libraries for text conversion (in design / experiments), to be plugged to I/O and a higher level foreign library. * PackedString. * StringBuffer and accepting source in encodings other than ISO-8859-1.
* [project @ 2000-08-01 09:08:25 by simonpj]simonpj2000-08-012-21/+83
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Simon's Marktoberdorf Commits 1. Tidy up the renaming story for "system binders", such as dictionary functions, default methods, constructor workers etc. These are now documented in HsDecls. The main effect of the change, apart from tidying up, is to make the *type-checker* (instead of the renamer) generate names for dict-funs and default-methods. This is good because Sergei's generic-class stuff generates new classes at typecheck time. 2. Fix the CSE pass so it does not require the no-shadowing invariant. Keith discovered that the simplifier occasionally returns a result with shadowing. After much fiddling around (which has improved the code in the simplifier a bit) I found that it is nearly impossible to arrange that it really does do no-shadowing. So I gave up and fixed the CSE pass (which is the only one to rely on it) instead. 3. Fix a performance bug in the simplifier. The change is in SimplUtils.interestingArg. It computes whether an argment should be considered "interesting"; if a function is applied to an interesting argument, we are more likely to inline that function. Consider this case let x = 3 in f x The 'x' argument was considered "uninteresting" for a silly reason. Since x only occurs once, it was unconditionally substituted, but interestingArg didn't take account of that case. Now it does. I also made interestingArg a bit more liberal. Let's see if we get too much inlining now. 4. In the occurrence analyser, we were choosing a bad loop breaker. Here's the comment that's now in OccurAnal.reOrderRec score ((bndr, rhs), _, _) | exprIsTrivial rhs = 3 -- Practically certain to be inlined -- Used to have also: && not (isExportedId bndr) -- But I found this sometimes cost an extra iteration when we have -- rec { d = (a,b); a = ...df...; b = ...df...; df = d } -- where df is the exported dictionary. Then df makes a really -- bad choice for loop breaker I also increased the score for bindings with a non-functional type, so that dictionaries have a better chance of getting inlined early 5. Add a hash code to the InScopeSet (and make it properly abstract) This should make uniqAway a lot more robust. Simple experiments suggest that uniqAway no longer gets into the long iteration chains that it used to. 6. Fix a bug in the inliner that made the simplifier tend to get into a loop where it would keep iterating ("4 iterations, bailing out" message). In SimplUtils.mkRhsTyLam we float bindings out past a big lambda, thus: x = /\ b -> let g = \x -> f x x in E becomes g* = /\a -> \x -> f x x x = /\ b -> let g = g* b in E It's essential that we don't simply inling g* back into the RHS of g, else we will be back to square 1. The inliner is meant not to do this because there's no benefit to the inlining, but the size calculation was a little off in CoreUnfold. 7. In SetLevels we were bogus-ly building a Subst with an empty in-scope set, so a WARNING popped up when compiling some modules. (knights/ChessSetList was the example that tickled it.) Now in fact the warning wasn't an error, but the Right Thing to do is to carry down a proper Subst in SetLevels, so that is what I have now done. It is very little more expensive.
* [project @ 2000-07-17 11:28:00 by simonpj]simonpj2000-07-171-9/+17
| | | | Print operator names in HsExpr better
* [project @ 2000-07-14 08:17:36 by simonpj]simonpj2000-07-144-14/+40
| | | | | | | | | | | | | | | | | | | | | | | This commit completely re-does the kind-inference mechanism. Previously it was inter-wound with type inference, but that was always hard to understand, and it finally broke when we started checking for ambiguity when type-checking a type signature (details irrelevant). So now kind inference is more clearly separated, so that it never takes place at the same time as type inference. The biggest change is in TcTyClsDecls, which does the kind inference for a group of type and class declarations. It now contains comments to explain how it all works. There are also comments in TypeRep which describes the slightly tricky way in which we deal with the fact that kind 'type' (written '*') actually has 'boxed type' and 'unboxed type' as sub-kinds. The whole thing is a bit of a hack, because we don't really have sub-kinding, but it's less of a hack than before. A lot of general tidying up happened at the same time. In particular, I removed some dead code here and there
* [project @ 2000-07-11 16:12:11 by simonmar]simonmar2000-07-113-12/+3
| | | | remove unused imports
* [project @ 2000-06-28 21:54:06 by lewie]lewie2000-06-281-1/+1
| | | | | | | | Make it so that implicit params uniformly print with the `?' at the front of the name. Simon's last big commit re-arranged how interface files were written, and implicit params were suddenly being written without the `?'. This fixes both that bug, and Simon's concern that there were too many different pretty printing functions for implicit params ;-)
* [project @ 2000-06-28 11:28:27 by simonmar]simonmar2000-06-281-0/+3
| | | | add missing default case for Eq (TyClDecl name pat)
* [project @ 2000-06-27 16:36:00 by lewie]lewie2000-06-271-3/+1
| | | | Cleaned out a handful of unused imports.
* [project @ 2000-06-18 08:37:17 by simonpj]simonpj2000-06-182-2/+16
| | | | | | | | | | | | | | | | | | | | | | | | | | *** MERGE WITH 4.07 *** * Fix the ambiguity check in TcMonotype.lhs so that it is not carried out for types read from interface files. Some workers may get ambiguous types but that does not matter, and should not make compilation fail. More detail in the comments with TcMonoType.tc_type_kind (the HsForAll case) * Don't create specialisations for type applications where there's a matching rule. The rule should clearly take precedence. (Bug reported by Sven.) I havn't tested this fix. * Run the occurrence analyser after tidyCore, so that occurrence info (notably dead-var info) is correct for the code generators. This should fix Erik's problem, but again I've not tested the fix. The extra call is in Main.lhs * Fix CoreToStg so that it can handle an StgLam in mkStgCase. This only shows up in a wierd case, documented in CoreToStg.mkStgCase