Skip to content
Snippets Groups Projects
  1. Sep 26, 2000
  2. Sep 25, 2000
  3. Sep 22, 2000
    • Simon Peyton Jones's avatar
      [project @ 2000-09-22 16:00:08 by simonpj] · 01d54e87
      Simon Peyton Jones authored
      Forgot to remove HsBasic and add HsLit
      01d54e87
    • Simon Peyton Jones's avatar
      [project @ 2000-09-22 15:56:12 by simonpj] · 1bba522f
      Simon Peyton Jones authored
      --------------------------------------------------
      	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
      1bba522f
    • Simon Peyton Jones's avatar
      [project @ 2000-09-22 15:47:14 by simonpj] · a8e1967f
      Simon Peyton Jones authored
      msg1
      a8e1967f
  4. Sep 14, 2000
    • Simon Marlow's avatar
      [project @ 2000-09-14 14:24:02 by simonmar] · 46b762e6
      Simon Marlow authored
      rename blockAsyncExceptions and unblockAsyncExceptions to block and
      unblock repectively, to match all the literature.  DEPRECATE the old
      names.
      46b762e6
    • Simon Peyton Jones's avatar
      [project @ 2000-09-14 13:46:39 by simonpj] · cae34044
      Simon Peyton Jones authored
      ---------------------------------------
      	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)
      cae34044
    • Simon Peyton Jones's avatar
      [project @ 2000-09-14 12:12:23 by simonpj] · 189333a4
      Simon Peyton Jones authored
      Improve the kind-inference test
      189333a4
    • Simon Marlow's avatar
      [project @ 2000-09-14 09:58:00 by simonmar] · fd1e4701
      Simon Marlow authored
      don't forget to bail out when "compilation IS NOT required"
      fd1e4701
    • Simon Marlow's avatar
      [project @ 2000-09-14 09:10:35 by simonmar] · 670b00ee
      Simon Marlow authored
      extend the scope of #ifdef GHCI so we can compile this with pre-4.08 compilers.
      670b00ee
    • Simon Peyton Jones's avatar
      [project @ 2000-09-14 08:17:54 by simonpj] · e1f4b5f4
      Simon Peyton Jones authored
      Fix bug in the driver that led to
      
      	Fail: system error
      	Action: getFileStatus
      
      It was due to Simon M's recent addition of modification-time
      checking.  You forgot to check whether the file M.o existed!
      e1f4b5f4
  5. Sep 13, 2000
  6. Sep 12, 2000
  7. Sep 11, 2000
    • Reuben Thomas's avatar
      [project @ 2000-09-11 15:04:08 by rrt] · 1448475b
      Reuben Thomas authored
      Implemented gettimeofday on Windows by calling GetTickCount(). This
      only seems to have a resolution of 1/100s, but that's just about OK
      for threadDelay, which only needs 50 ticks per second.
      1448475b
    • Reuben Thomas's avatar
      [project @ 2000-09-11 15:02:51 by rrt] · fa29f53b
      Reuben Thomas authored
      Pass --target to configure of GMP, so that building for mingwin under
      cygwin works properly.
      fa29f53b
    • Reuben Thomas's avatar
      [project @ 2000-09-11 14:56:17 by rrt] · 09672690
      Reuben Thomas authored
      Make sure windows.h is always checked for, not just when HOpenGL is present.
      09672690
    • Reuben Thomas's avatar
      [project @ 2000-09-11 14:11:25 by rrt] · c5244374
      Reuben Thomas authored
      Revised GHC installer size downwards.
      c5244374
    • Reuben Thomas's avatar
      [project @ 2000-09-11 13:56:22 by rrt] · 20ff806f
      Reuben Thomas authored
      Removed Windows FAQ about -static no longer being supported (it is).
      20ff806f
    • Julian Seward's avatar
      [project @ 2000-09-11 12:20:56 by sewardj] · 55945d0a
      Julian Seward authored
      First shot at a STG interpreter for GHCI.  Translates Stg syntax into a
      form convenient for interpretation, and can then run that.  Most of the
      translation stuff is there and works.  The interpreter framework is there
      and partly filled in, and seems to work.  There are still quite a lot of
      cases, etc, to fill in, but this should be straightforward given that
      the framework exists.  This interpreter cannot handle (yet?) unboxed
      tuples, but can deal with more or less everything else, including standard
      unboxed Int, Double, etc, code.
      55945d0a
    • Julian Seward's avatar
      [project @ 2000-09-11 11:17:09 by sewardj] · d4993e8b
      Julian Seward authored
      Initial primop support for the metacircular interpreter (GHCI).
      Only appears if you compile with -DGHCI; if not, the world is
      unchanged.
      
      new primops:
         indexPtrOffClosure#
         indexWordOffClosure#
      
      modified:
         dataToTag#   -- now dereferences indirections before extracting tag
      
      new entry code
         mci_constr_entry          and
         mci_constr[1..8]entry
      being the direct and vectored return code fragments for interpreter
      created constructors.  Support for static constructors is not yet
      done.
      
      New handwritten .hc functions:
         mci_make_constr*
      being code to create various flavours of constructors from args
      on the stack.  An interface file to describe these will follow in
      a later commit.
      d4993e8b
    • Simon Marlow's avatar
      [project @ 2000-09-11 09:27:14 by simonmar] · 3fc55f79
      Simon Marlow authored
      HP-PA fixes from Eric Schweitz <schweitz@nortelnetworks.com>
      3fc55f79
    • Simon Peyton Jones's avatar
      [project @ 2000-09-11 08:13:37 by simonpj] · d8e1c0a7
      Simon Peyton Jones authored
      Remove redundant setNoDiscardId call from Specialise.newIdSM
      d8e1c0a7
  8. Sep 10, 2000
  9. Sep 08, 2000
  10. Sep 07, 2000
    • Simon Peyton Jones's avatar
      [project @ 2000-09-07 16:32:23 by simonpj] · 4e6d5798
      Simon Peyton Jones authored
      A list of simplifier-related stuff, triggered
      	by looking at GHC's performance.
      
      	I don't guarantee that this lot will lead to
      	a uniform improvement over 4.08, but it it should
      	be a bit better.  More work probably required.
      
      
      * Make the simplifier's Stop continuation record whether the expression being
        simplified is the RHS of a thunk, or (say) the body of a lambda or case RHS.
        In the thunk case we want to be a bit keener about inlining if the type of
        the thunk is amenable to update in place.
      
      * Fix interestingArg, which was being too liberal, and hence doing
        too much inlining.
      
      * Extended CoreUtils.exprIsCheap to make two more things cheap:
          - 	case (coerce x) of ...
          -   let x = y +# z
        This makes a bit more eta expansion happen.  It was provoked by
        a program of Marcin's.
      
      * MkIface.ifaceBinds.   Make sure that we emit rules for things
        (like class operations) that don't get a top-level binding in the
        interface file.  Previously such rules were silently forgotten.
      
      * Move transformRhs to *after* simplification, which makes it a
        little easier to do, and means that the arity it computes is
        readily available to completeBinding.  This gets much better
        arities.
      
      * Do coerce splitting in completeBinding. This gets good code for
      	newtype CInt = CInt Int
      
      	test:: CInt -> Int
      	test x = case x of
      	      	   1 -> 2
      	      	   2 -> 4
      	      	   3 -> 8
      	      	   4 -> 16
      	      	   _ -> 0
      
      * Modify the meaning of "arity" so that during compilation it means
        "if you apply this function to fewer args, it will do virtually
        no work".   So, for example
      	f = coerce t (\x -> e)
        has arity at least 1.  When a function is exported, it's arity becomes
        the number of exposed, top-level lambdas, which is subtly different.
        But that's ok.
      
        I removed CoreUtils.exprArity altogether: it looked only at the exposed
        lambdas.  Instead, we use exprEtaExpandArity exclusively.
      
        All of this makes I/O programs work much better.
      4e6d5798
    • Simon Peyton Jones's avatar
      [project @ 2000-09-07 16:31:45 by simonpj] · e9f0fa88
      Simon Peyton Jones authored
      * The simplifier used to glom together all the top-level bindings into
        a single Rec every time it was invoked.  The reason for this is explained
        in SimplCore.lhs, but for at least one simple program it meant that the
        simplifier never got around to unravelling the recursive group into
        non-recursive pieces.  So I've put the glomming under explicit flag
        control with a -fglom-binds simplifier pass.   A side benefit is
        that because it happens less often, the (expensive) SCC algorithm
        runs less often.
      e9f0fa88
    • Simon Peyton Jones's avatar
      [project @ 2000-09-07 16:29:36 by simonpj] · 0f70a20e
      Simon Peyton Jones authored
      Omit unnecessary import
      0f70a20e
    • Simon Peyton Jones's avatar
      [project @ 2000-09-07 16:28:44 by simonpj] · 2c7fe84e
      Simon Peyton Jones authored
      Do the begin-pass/end-pass stuff like the other core passes
      2c7fe84e
Loading