projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-07-15 14:08:03 by keithw]
[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index ade69fd..3621264 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -5,7 +5,7 @@ module ParseIface ( parseIface, IfaceStuff(..) ) where
 
 import HsSyn           -- quite a bit of stuff
 import RdrHsSyn                -- oodles of synonyms
-import HsTypes         ( mkHsForAllTy )
+import HsTypes         ( mkHsForAllTy, mkHsUsForAllTy )
 import HsCore
 import Const           ( Literal(..), mkMachInt_safe )
 import BasicTypes      ( Fixity(..), FixityDirection(..), 
@@ -25,7 +25,7 @@ import FiniteMap      ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
 import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
 import Name            ( OccName, Provenance )
 import OccName          ( mkSysOccFS,
-                         tcName, varName, dataName, clsName, tvName,
+                         tcName, varName, dataName, clsName, tvName, uvName,
                          EncodedFS 
                        )
 import Module           ( ModuleName, mkSysModuleFS )                  
@@ -43,9 +43,9 @@ import Ratio ( (%) )
 }
 
 %name      parseIface
-%tokentype  { IfaceToken }
-%monad     { IfM }{ thenIf }{ returnIf }
-%lexer      { lexIface } { ITeof }
+%tokentype  { Token }
+%monad     { P }{ thenP }{ returnP }
+%lexer      { lexer } { ITeof }
 
 %token
  'case'        { ITcase }                      -- Haskell keywords
@@ -73,10 +73,17 @@ import Ratio ( (%) )
  'qualified'   { ITqualified }
  'hiding'      { IThiding }
 
- '__interface' { ITinterface }                 -- GHC-extension keywords
- '__export'    { ITexport }
+ 'forall'      { ITforall }                    -- GHC extension keywords
+ 'foreign'     { ITforeign }
+ 'export'      { ITexport }
+ 'label'       { ITlabel } 
+ 'dynamic'     { ITdynamic }
+ 'unsafe'      { ITunsafe }
+
+ '__interface' { ITinterface }                 -- interface keywords
+ '__export'    { IT__export }
+ '__forall'    { IT__forall }
  '__depends'   { ITdepends }
- '__forall'    { ITforall }
  '__letrec'    { ITletrec }
  '__coerce'    { ITcoerce }
  '__inline_call'{ ITinlineCall }
@@ -93,8 +100,8 @@ import Ratio ( (%) )
  '__scc'       { ITscc }
  '__sccC'       { ITsccAllCafs }
 
- '__o'         { ITonce }
- '__m'         { ITmany }
+ '__u'         { ITusage }
+ '__fuall'     { ITfuall }
 
  '__A'         { ITarity }
  '__P'         { ITspecialise }
@@ -145,6 +152,7 @@ import Ratio ( (%) )
  STRING                { ITstring   $$ }
  INTEGER       { ITinteger  $$ }
  RATIONAL      { ITrational $$ }
+ CLITLIT       { ITlitlit   $$ }
 
  UNKNOWN       { ITunknown  $$ }
 %%
@@ -303,19 +311,29 @@ decl    : src_loc var_name '::' type maybe_idinfo
 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 maybe_idinfo  : {- empty -}    { \_ -> [] }
              | src_loc PRAGMA  { \x -> 
-                                  case parseIface $2 $1 of
-                                    Succeeded (PIdInfo id_info) -> id_info
-                                    Failed err -> pprPanic "IdInfo parse failed" 
-                                                           (vcat [ppr x, err])
+                                  case parseIface $2
+                                          PState{bol = 0#, atbol = 1#,
+                                                 context = [],
+                                                 glasgow_exts = 1#,
+                                                 loc = $1 } of
+                                    POk _ (PIdInfo id_info) -> id_info
+                                    PFailed err -> 
+                                       pprPanic "IdInfo parse failed" 
+                                           (vcat [ppr x, err])
                                }
 
 -----------------------------------------------------------------------------
 
 rules_part :: { [RdrNameRuleDecl] }
 rules_part : {- empty -}       { [] }
-          | src_loc PRAGMA     { case parseIface $2 $1 of
-                                    Succeeded (PRules rules) -> rules
-                                    Failed err -> pprPanic "Rules parse failed" err
+          | src_loc PRAGMA     { case parseIface $2 
+                                          PState{bol = 0#, atbol = 1#,
+                                                 context = [],
+                                                 glasgow_exts = 1#,
+                                                 loc = $1 }  of
+                                    POk _ (PRules rules) -> rules
+                                    PFailed err -> 
+                                         pprPanic "Rules parse failed" err
                                }
 
 rules     :: { [RdrNameRuleDecl] }
@@ -338,7 +356,7 @@ decl_context        :: { RdrNameContext }
 decl_context   :                                       { [] }
                | '{' context_list1 '}' '=>'    { $2 }
 
-----------------------------------------------------------------
+----------------------------------------------------------------------------
 
 constrs                :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
                :                       { [] }
@@ -383,11 +401,15 @@ field             :  var_names1 '::' type         { ($1, Unbanged $3) }
 --------------------------------------------------------------------------
 
 type           :: { RdrNameHsType }
-type           : '__forall' forall context '=>' type   
+type           : '__fuall'  fuall '=>' type    { mkHsUsForAllTy $2 $4 }
+                | '__forall' forall context '=>' type  
                                                { mkHsForAllTy $2 $3 $5 }
                | btype '->' type               { MonoFunTy $1 $3 }
                | btype                         { $1 }
 
+fuall          :: { [RdrName] }
+fuall          : '[' uv_bndrs ']'                      { $2 }
+
 forall         :: { [HsTyVar RdrName] }
 forall         : '[' tv_bndrs ']'                      { $2 }
 
@@ -409,8 +431,12 @@ types2             :  type ',' type                        { [$1,$3] }
 btype          :: { RdrNameHsType }
 btype          :  atype                                { $1 }
                |  btype atype                          { MonoTyApp $1 $2 }
-                |  '__o' atype                         { MonoUsgTy UsOnce $2 }
-                |  '__m' atype                         { MonoUsgTy UsMany $2 }
+                |  '__u' usage atype                   { MonoUsgTy $2 $3 }
+
+usage          :: { MonoUsageAnn RdrName }
+usage          : '-'                                   { MonoUsOnce }
+               | '!'                                   { MonoUsMany }
+               | uv_name                               { MonoUsVar $1 }
 
 atype          :: { RdrNameHsType }
 atype          :  qtc_name                             { MonoTyVar $1 }
@@ -440,9 +466,16 @@ mod_name   :: { ModuleName }
 var_fs         :: { EncodedFS }
                : VARID                 { $1 }
                | VARSYM                { $1 }
-               | '-'                   { SLIT("-") }
                | '!'                   { SLIT("!") }
-
+               | 'as'                  { SLIT("as") }
+               | 'qualified'           { SLIT("qualified") }
+               | 'hiding'              { SLIT("hiding") }
+               | 'forall'              { SLIT("forall") }
+               | 'foreign'             { SLIT("foreign") }
+               | 'export'              { SLIT("export") }
+               | 'label'               { SLIT("label") }
+               | 'dynamic'             { SLIT("dynamic") }
+               | 'unsafe'              { SLIT("unsafe") }
 
 qvar_fs                :: { (EncodedFS, EncodedFS) }
                :  QVARID               { $1 }
@@ -520,6 +553,17 @@ qcls_name  :: { RdrName }
                | qdata_fs              { mkSysQual clsName $1 }
 
 ---------------------------------------------------
+uv_name                :: { RdrName }
+               :  VARID                { mkSysUnqual uvName $1 }
+
+uv_bndr                :: { RdrName }
+               :  uv_name              { $1 }
+
+uv_bndrs       :: { [RdrName] }
+               :                       { [] }
+               | uv_bndr uv_bndrs      { $1 : $2 }
+
+---------------------------------------------------
 tv_name                :: { RdrName }
                :  VARID                { mkSysUnqual tvName $1 }
                |  VARSYM               { mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
@@ -551,31 +595,15 @@ akind             :: { Kind }
 id_info                :: { [HsIdInfo RdrName] }
                :                               { [] }
                | id_info_item id_info          { $1 : $2 }
-                | strict_info id_info          { $1 ++ $2 }
 
 id_info_item   :: { HsIdInfo RdrName }
-               : '__A' arity_info              { HsArity $2 }
+               : '__A' INTEGER                 { HsArity (exactArity (fromInteger $2)) }
                | '__U' core_expr               { HsUnfold $1 (Just $2) }
                 | '__U'                        { HsUnfold $1 Nothing }
+               | '__M'                         { HsCprInfo $1 }
+               | '__S'                         { HsStrictness (HsStrictnessInfo $1) }
                | '__C'                         { HsNoCafRefs }
-
-strict_info     :: { [HsIdInfo RdrName] }
-               : cpr worker                    { ($1:$2) }
-               | strict worker                 { ($1:$2) }
-               | cpr strict worker             { ($1:$2:$3) }
-
-cpr            :: { HsIdInfo RdrName }
-               : '__M'                         { HsCprInfo $1 }
-
-strict         :: { HsIdInfo RdrName }
-               : '__S'                         { HsStrictness (HsStrictnessInfo $1) }
-
-worker         :: { [HsIdInfo RdrName] }
-               : qvar_name                     { [HsWorker $1] }
-               | {- nothing -}                 { [] }
-
-arity_info     :: { ArityInfo }
-               : INTEGER                       { exactArity (fromInteger $1) }
+               | '__P' qvar_name               { HsWorker $2 }
 
 -------------------------------------------------------
 core_expr      :: { UfExpr RdrName }
@@ -670,23 +698,31 @@ comma_var_names1 : var_name                                       { [$1] }
                 | var_name ',' comma_var_names1                { $1 : $3 }
 
 core_lit       :: { Literal }
-core_lit       : INTEGER                       { mkMachInt_safe $1 }
+core_lit       : integer                       { mkMachInt_safe $1 }
                | CHAR                          { MachChar $1 }
                | STRING                        { MachStr $1 }
                | '__string' STRING             { NoRepStr $2 (panic "NoRepStr type") }
-               | RATIONAL                      { MachDouble $1 }
-               | '__float' RATIONAL            { MachFloat $2 }
+               | rational                      { MachDouble $1 }
+               | '__float' rational            { MachFloat $2 }
 
-               | '__integer' INTEGER           { NoRepInteger  $2 (panic "NoRepInteger type") 
+               | '__integer' integer           { NoRepInteger  $2 (panic "NoRepInteger type") 
                                                        -- The type checker will add the types
                                                }
 
-               | '__rational' INTEGER INTEGER  { NoRepRational ($2 % $3) 
+               | '__rational' integer integer  { NoRepRational ($2 % $3) 
                                                   (panic "NoRepRational type")
                                                        -- The type checker will add the type
                                                }
 
-               | '__addr' INTEGER              { MachAddr $2 }
+               | '__addr' integer              { MachAddr $2 }
+
+integer                :: { Integer }
+               : INTEGER                       { $1 }
+               | '-' INTEGER                   { (-$2) }
+
+rational       :: { Rational }
+               : RATIONAL                      { $1 }
+               | '-' RATIONAL                  { (-$2) }
 
 core_bndr       :: { UfBinder RdrName }
 core_bndr       : core_val_bndr                                 { $1 }
@@ -705,6 +741,7 @@ core_tv_bndr        :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
 
 ccall_string   :: { FAST_STRING }
                : STRING                                        { $1 }
+               | CLITLIT                                       { $1 }
                | VARID                                         { $1 }
                | CONID                                         { $1 }
 
@@ -730,7 +767,7 @@ cc_caf  :: { IsCafCC }
 -------------------------------------------------------------------
 
 src_loc :: { SrcLoc }
-src_loc :                              {% getSrcLocIf }
+src_loc :                              {% getSrcLocP }
 
 checkVersion :: { () }
           : {-empty-}                  {% checkVersion Nothing }
@@ -740,6 +777,8 @@ checkVersion :: { () }
 
 --                     Haskell code 
 {
+happyError :: P a
+happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
 data IfaceStuff = PIface       EncodedFS{-.hi module name-} ParsedIface
                | PIdInfo       [HsIdInfo RdrName]
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)