[jhc] ignore optimizer phase information for INLINE pragmas as available in GHC

Henning Thielemann jhc at henning-thielemann.de
Sat Nov 14 16:57:40 EST 2009


In low-level packages like bytestring and storablevector we have pragmas 
like

  {-# INLINE [1] func #-}

The attached patch ignores the number, that specifies the optimizer phase 
where inlining shall happen. Ignoring that information is certainly not 
the best way, since an "inline only in phase x" may be meant as "better 
inline too seldom than too often". But this way I might get bytestring 
compiled without many modifications. At least I like to give a warning, 
when phase information is ignored, but I could not get that for now.

Now when compiling Data.ByteString I am lost at:

./Data/ByteString.hs:1942 - Error: Unknown name: illegalOperationErrorType
./Data/ByteString.hs:1942 - Error: Unknown name: mkIOError
cabal: Error: some packages failed to install:
bytestring-0.9.1.5 failed during the building phase. The exception was:

I don't know what the current state of exceptions in JHC is.
-------------- next part --------------
Sat Nov 14 22:48:29 CET 2009  jhc at henning-thielemann.de
  * HsParser, Lexer: ignore optimizer phase information for INLINE pragmas as available in GHC
  ToDo: emit warning that phase information is ignored

New patches:

[HsParser, Lexer: ignore optimizer phase information for INLINE pragmas as available in GHC
jhc at henning-thielemann.de**20091114214829
 Ignore-this: 2a7ac0d6484724bd19be7148e377163a
 ToDo: emit warning that phase information is ignored
] hunk ./src/FrontEnd/HsParser.y 66
       USTRING  { UStringTok $$ }
       PRAGMAOPTIONS { PragmaOptions $$ }
       PRAGMASTART { PragmaStart $$ }
+      PRAGMAINLINE { PragmaInline $$ }
       PRAGMARULES { PragmaRules $$ }
       PRAGMASPECIALIZE { PragmaSpecialize $$ }
       PRAGMAEND { PragmaEnd }
hunk ./src/FrontEnd/HsParser.y 368
       : signdecl                      { $1 }
       | fixdecl                       { $1 }
       | valdef                        { $1 }
+      | pragmainline                  { $1 }
       | pragmaprops                   { $1 }
 
 
hunk ./src/FrontEnd/HsParser.y 380
 signdecl :: { HsDecl }
       : vars srcloc '::' ctype        { HsTypeSig $2 (reverse $1) $4 }
 
+pragmainline  :: { HsDecl }
+      : PRAGMAINLINE srcloc optphasesn vars PRAGMAEND  { HsPragmaProps $2 $1 $4 }
+
+optphasesn :: { (Bool, Maybe Int) }
+      : '~' optphases                 { (True, $2) }
+      | optphases                     { (False, $1) }
+
+optphases :: { Maybe Int }
+      : '[' INT ']'                   { (Just (readInteger $2)) }
+      |                               { Nothing }
+
 pragmaprops  :: { HsDecl }
       : PRAGMASTART srcloc  vars PRAGMAEND  { HsPragmaProps $2 $1 $3 }
 
hunk ./src/FrontEnd/Lexer.hs 48
         | StringTok String
         | UStringTok String
         | PragmaOptions [String]
+        | PragmaInline String          -- also for NOINLINE
         | PragmaRules Bool
         | PragmaSpecialize Bool
         | PragmaStart String
hunk ./src/FrontEnd/Lexer.hs 659
 
 -- pragmas which just have a simple string based start rule.
 pragmas_std = [
-    ["INLINE"],
     ["NOETA"],
     ["SUPERINLINE"],
hunk ./src/FrontEnd/Lexer.hs 661
-    ["NOINLINE","NOTINLINE"],
     ["MULTISPECIALIZE", "MULTISPECIALISE"],
     ["SRCLOC_ANNOTATE"]
     ]
hunk ./src/FrontEnd/Lexer.hs 667
 
 -- pragmas with a special starting token
 pragmas_parsed = [
+    (["INLINE"],PragmaInline "INLINE"),
+    (["NOINLINE","NOTINLINE"],PragmaInline "NOINLINE"),
     (["RULES","RULE","RULES_JHC","RULE_JHC"],PragmaRules False),
     (["CATALYST","CATALYSTS"],PragmaRules True),
     (["SPECIALIZE", "SPECIALISE"],PragmaSpecialize False),

Context:

[use appropriate mingw gcc in targets.ini
David Roundy <roundyd at physics.oregonstate.edu>**20090923113532
 Ignore-this: b57826eb6a9bc173787e757978da84aa6bca48a5
] 
[add System.IO.Pipe.
David Roundy <roundyd at physics.oregonstate.edu>**20090920222021
 Ignore-this: 41e186c1bb31ebcfea1dbaade4198b52f7cfefc6
] 
[allow selecting libraries by hash or name-version
John Meacham <john at repetae.net>**20090916092017
 Ignore-this: 791898f2515ce09fdf14bcfa55374d0f
] 
[removed use of RecordWildCards, which is buggy in ghc 6.8.
David Roundy <droundy at darcs.net>**20090909104653
 Ignore-this: a25acfe97b9d49f3d671e7de713398c42d480084
] 
[change description of -c command.
David Roundy <roundyd at physics.oregonstate.edu>**20090909214755
 Ignore-this: 9dfd9feacaae12d3a9347795c9218a3edccdca97
] 
[add warnings not to edit auto-generated Prim.hs file.
David Roundy <roundyd at physics.oregonstate.edu>**20090905163828
 Ignore-this: 8ea3a7ae45154a7065dd3c6cca027d21b0fd6d14
] 
[expand --list-libraries output with lots of new info
John Meacham <john at repetae.net>**20090908001803
 Ignore-this: d2eb4972842f4d2537723145b8f4aa46
] 
[add Util.YAML
John Meacham <john at repetae.net>**20090908000054
 Ignore-this: 710d1cc5bb1eb25a071a1303a0a295ae
] 
[perform dependency analysis on type synonyms before expansion, detect recursive synonyms.
John Meacham <john at repetae.net>**20090907110339
 Ignore-this: dbdc78dd0f53b0d4d88f5bde202859ce
] 
[add Ord instances for 3 and 4-tuples
John Meacham <john at repetae.net>**20090906093322
 Ignore-this: b5501f8a6af7447f5270c9929099c4a0
] 
[fix ord instance for lists
John Meacham <john at repetae.net>**20090906015622
 Ignore-this: 7474720527a381364a95f637fdde4be7
] 
[have the ho cache names depend on the compiler version, to avoid cache poisoning by fixed bugs
John Meacham <john at repetae.net>**20090906001329
 Ignore-this: 92b4b18987980ccbcad1acc382049db1
] 
[add 'constraints' test from nobench to regression tests
John Meacham <john at repetae.net>**20090905231129
 Ignore-this: 968420a6871dedfe09835d329dea7b4d
] 
[allow deadcode and node analysis to see constant partial applications that are arguments to a store
John Meacham <john at repetae.net>**20090905224714
 Ignore-this: f046a8c860f832b6185d8868fa474c0
] 
[bump version number
John Meacham <john at repetae.net>**20090905112620
 Ignore-this: 94f12cb57766a0ad6087282b05ddcf3e
] 
[enable storage analysis to enable allocation on the stack
John Meacham <john at repetae.net>**20090905112613
 Ignore-this: 698cba1f286da15511ab00db0f641348
] 
[clean up fixIO
David Roundy <droundy at darcs.net>**20090905130434
 Ignore-this: a54d45a08fed774311a62f397aa277d763c9b55d
] 
[allow C generator to handle unknown values properly
John Meacham <john at repetae.net>**20090905070241
 Ignore-this: 45b178166521d1415a83296a417637ad
] 
[fix desugaring inside of list comprehensions
John Meacham <john at repetae.net>**20090905063231
 Ignore-this: 45bfed7194caf9b2d121a8c6ee5eef3d
] 
[use strict writer monad as suggested by Taral
John Meacham <john at repetae.net>**20090905061722
 Ignore-this: 4ad850e2a1eaa59b18100781892a002
] 
[fix strict newtypes bug
John Meacham <john at repetae.net>**20090905061645
 Ignore-this: 5def4f36458cb6dbec327fe3bdcb3979
] 
[clean ups
John Meacham <john at repetae.net>**20090905042239
 Ignore-this: d586cddf774cd044103288aa1554b6cd
] 
[fix instance of U2U primitive not being processed properly
John Meacham <john at repetae.net>**20090905042149
 Ignore-this: 24858b196abd2eb0d1362edf16c85894
] 
[add regression test for strict newtype bug
John Meacham <john at repetae.net>**20090905042131
 Ignore-this: d1d47e60b8e131aec734ec755026fe7d
] 
[start adding storage analysis support
John Meacham <john at repetae.net>**20090905015718
 Ignore-this: 2a1f36882b7824cbb4f40403afd46ec1
] 
[bug updates
John Meacham <john at repetae.net>**20090905010650
 Ignore-this: fda7e81bf1e7d0323adfd175babb4f02
] 
[add mockbuild.sh to repo
John Meacham <john at repetae.net>**20090902002058
 Ignore-this: 3d00049b26da191f4950b973c8e36df
] 
[ add a lot of new regression tests, many bugs that the lhc developers found, make regress.prl check the 'mustfail' status of tests
John Meacham <john at repetae.net>**20090902002017
 Ignore-this: 455861464ee8627b72f3dc343d7447e9
] 
[include $PREFIX/{share,lib}/{jhc,jhc-$SHORTVERSION} in search path.
David Roundy <roundyd at physics.oregonstate.edu>**20090902162853
 Ignore-this: 640fb797a3d27327bd6cb9f4333b5793cf974529
 I find it a little annoying that the default search path doesn't
 include the location where I installed jhc, except the
 ../share/jhc-0.7 directory, which I'd rather not put stuff in, so I
 can easily delete all non-standard packages.
 
 I also took the liberty of reordering the default search path, so that
 all the ~/* entries would be before all the /usr/local/* entries, etc.
] 
[give nicer error message on jhc --show-ho foo
David Roundy <roundyd at physics.oregonstate.edu>**20090902162143
 Ignore-this: 187d8cf167aa67786882e458400edc2b20c4a6db
] 
[make type of System.Info.compilerVersion match that of ghc.
David Roundy <droundy at darcs.net>**20090902124418
 Ignore-this: cc1d7ba17598da69f8dc7d2d96c3d266811413c0
] 
[introduce System.Exit and System.Cmd in base.
David Roundy <droundy at darcs.net>**20090831150645
 Ignore-this: 0b2496708bc3741a0500d796cb144939cc868578
] 
[fix grammatical error in warning message.
David Roundy <roundyd at physics.oregonstate.edu>**20090902192312
 Ignore-this: ff2af3d11325d300c217ac7776b82097bbb2c3a9
] 
[fix bug when 'do' expressions used with infix expressions, add test case to regression
John Meacham <john at repetae.net>**20090901180831
 Ignore-this: 3feaf0ddff33116c54017f18d8fb372a
] 
[TAG 0.7.2
John Meacham <john at repetae.net>**20090901063747
 Ignore-this: 15bfbae8da4d333a8d2777e7e49144a0
] 
Patch bundle hash:
9d1bb48ec45fb1cc4680b23f249a66f409b4f9a4


More information about the jhc mailing list