Treat type operators as constants, not variables.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 16 Jan 2011 21:44:28 +0000 (13:44 -0800)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 16 Jan 2011 21:44:28 +0000 (13:44 -0800)
Modifies the parser to treat all infix operators at the type level
as constants, not type variables.

This allows us to make definitions such as this:

>  data a + b = Test

Change to import/exports
~~~~~~~~~~~~~~~~~~~~~~~~

With this change, writing (+) in an import/export specification is
ambiguous because it is not clear if we should be importing/exporting
the value level (+) or the type level one, or both.

We solve this as follows:

- Specifications which have subrodinates are aways types.
  For example, T(), F(..), and (+)() all refer to types.

- Specification which do not have subbordinates remain unchanged:
  - variable names refer to values:   f, (+)
  - constructor names refer to types: T, F, (:+)

- Because (+)() looks odd, we also add a bit of new syntax.  Writing:

> type (+)

is an abbreviation for:

> (+)()

(i.e., it imports/exports a type or class without any of its subordinates).

To avoid clutter, we also allow multiple type/class constructors to be
mentioned in a single 'type' specificatoin.  For example:

>  type (+) (-) TypeNat

imports/exports all of the specified types/classes.

compiler/basicTypes/OccName.lhs
compiler/parser/Parser.y.pp
compiler/parser/RdrHsSyn.lhs

index 439a2f8..ff4444f 100644 (file)
@@ -466,7 +466,7 @@ isDataSymOcc _                    = False
 -- it is a data constructor or variable or whatever)
 isSymOcc :: OccName -> Bool
 isSymOcc (OccName DataName s)  = isLexConSym s
-isSymOcc (OccName TcClsName s) = isLexConSym s
+isSymOcc (OccName TcClsName s) = isLexSym s
 isSymOcc (OccName VarName s)   = isLexSym s
 isSymOcc (OccName TvName s)    = isLexSym s
 -- Pretty inefficient!
index a0cc964..c71e62d 100644 (file)
@@ -43,7 +43,7 @@ import OccName                ( varName, dataName, tcClsName, tvName )
 import DataCon         ( DataCon, dataConName )
 import SrcLoc          ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
                          SrcSpan, combineLocs, srcLocFile, 
-                         mkSrcLoc, mkSrcSpan )
+                         mkSrcLoc, mkSrcSpan, noSrcSpan )
 import Module
 import StaticFlags     ( opt_SccProfilingOn, opt_Hpc )
 import Type            ( Kind, liftedTypeKind, unliftedTypeKind )
@@ -447,8 +447,8 @@ exportlist :: { [LIE RdrName] }
        | exportlist1                           { $1 }
 
 exportlist1 :: { [LIE RdrName] }
-        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 : $3) ++ $5 }
-       | expdoclist export expdoclist                 { $1 ++ ($2 : $3) }
+        : expdoclist export expdoclist ',' exportlist  { $1 ++ ($2 ++ $3) ++ $5 }
+       | expdoclist export expdoclist                 { $1 ++ ($2 ++ $3) }
        | expdoclist                                   { $1 }
 
 expdoclist :: { [LIE RdrName] }
@@ -460,15 +460,22 @@ exp_doc :: { LIE RdrName }
         | docnamed      { L1 (IEDocNamed ((fst . unLoc) $1)) } 
         | docnext       { L1 (IEDoc (unLoc $1)) }       
                        
-   -- No longer allow things like [] and (,,,) to be exported
+   -- NOTE 1: No longer allow things like [] and (,,,) to be exported
    -- They are built in syntax, always available
-export         :: { LIE RdrName }
-       :  qvar                         { L1 (IEVar (unLoc $1)) }
-       |  oqtycon                      { L1 (IEThingAbs (unLoc $1)) }
-       |  oqtycon '(' '..' ')'         { LL (IEThingAll (unLoc $1)) }
-       |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
-       |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
-       |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
+   -- NOTE 2: There is a lot of overlap between value and type names,
+   -- so, in the general case, we parse everything as values,
+   -- and post-process the declaration to determine what is being exported.
+export         :: { [LIE RdrName] }
+       : qcname opt_subordinates { [L (comb3 $1 $1 $2)
+                                       (mkExportSpec (unLoc $1) (unLoc $2))] }
+        | 'type' oqtycons1        { map (fmap IEThingAbs) $2 }
+       | 'module' modid          { [LL (IEModuleContents (unLoc $2))] }
+
+opt_subordinates :: { Located (Maybe Subordinates) }
+        : {- empty -}             { L0 Nothing }
+        | '(' '..' ')'            { LL (Just SubordinateAll) }
+        | '(' ')'                { LL (Just (SubordinateList [])) }
+        | '(' qcnames ')'         { LL (Just (SubordinateList (reverse $2))) }
 
 qcnames :: { [RdrName] }
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
@@ -1722,6 +1729,10 @@ gtycon   :: { Located RdrName }  -- A "general" qualified tycon
        | '[' ']'                       { LL $ listTyCon_RDR }
        | '[:' ':]'                     { LL $ parrTyCon_RDR }
 
+oqtycons1 :: { [Located RdrName] }
+        : oqtycon                       { [$1] }
+        | oqtycons1 oqtycon             { $2 : $1 }
+
 oqtycon :: { Located RdrName } -- An "ordinary" qualified tycon
        : qtycon                        { $1 }
        | '(' qtyconsym ')'             { LL (unLoc $2) }
@@ -1744,6 +1755,15 @@ qtyconsym :: { Located RdrName }
 
 tyconsym :: { Located RdrName }
        : CONSYM                        { L1 $! mkUnqual tcClsName (getCONSYM $1) }
+        -- Does not include "!", because that is used for strictness marks
+        -- or ".", because that separates the quantified type vars from the rest
+        -- or "*", because that's used for kinds  (XXX: Add this)
+        | VARSYM                       { L1 $! mkUnqual tcClsName (getVARSYM $1) }
+        | '*'                           { L1 $! mkUnqual tcClsName (fsLit "*") }
+    
+
+
+
 
 -----------------------------------------------------------------------------
 -- Operators
@@ -1777,11 +1797,9 @@ qvaropm :: { Located RdrName }
 
 tyvar   :: { Located RdrName }
 tyvar   : tyvarid              { $1 }
-       | '(' tyvarsym ')'      { LL (unLoc $2) }
 
 tyvarop :: { Located RdrName }
 tyvarop : '`' tyvarid '`'      { LL (unLoc $2) }
-       | tyvarsym              { $1 }
        | '.'                   {% parseErrorSDoc (getLoc $1) 
                                      (vcat [ptext (sLit "Illegal symbol '.' in type"), 
                                             ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"),
@@ -1796,12 +1814,6 @@ tyvarid  :: { Located RdrName }
        | 'interruptible'       { L1 $! mkUnqual tvName (fsLit "interruptible") }
        | 'threadsafe'          { L1 $! mkUnqual tvName (fsLit "threadsafe") }
 
-tyvarsym :: { Located RdrName }
--- Does not include "!", because that is used for strictness marks
---              or ".", because that separates the quantified type vars from the rest
---              or "*", because that's used for kinds
-tyvarsym : VARSYM              { L1 $! mkUnqual tvName (getVARSYM $1) }
-
 -----------------------------------------------------------------------------
 -- Variables 
 
index 47abf23..4df2a29 100644 (file)
@@ -25,6 +25,8 @@ module RdrHsSyn (
         parseCImport,
        mkExport,
        mkExtName,           -- RdrName -> CLabelString
+        Subordinates(..),
+        mkExportSpec,
        mkGadtDecl,          -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
        mkSimpleConDecl, 
        mkDeprecatedGadtRecordDecl,
@@ -60,7 +62,7 @@ import Lexer
 import TysWiredIn      ( unitTyCon ) 
 import ForeignCall
 import OccName         ( srcDataName, varName, isDataOcc, isTcOcc, 
-                         occNameString )
+                         occNameString, tcClsName )
 import PrelNames       ( forall_tv_RDR )
 import DynFlags
 import SrcLoc
@@ -1028,6 +1030,21 @@ mkExport cconv (L _ entity, v, ty) = return $
 --
 mkExtName :: RdrName -> CLabelString
 mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
+
+data Subordinates = SubordinateAll | SubordinateList [RdrName]
+
+mkExportSpec :: RdrName -> Maybe Subordinates -> IE RdrName
+mkExportSpec x subs =
+  case subs of
+    Nothing
+      | isRdrDataCon x        -> IEThingAbs ty
+      | otherwise             -> IEVar x
+    Just SubordinateAll       -> IEThingAll ty
+    Just (SubordinateList xs) -> IEThingWith ty xs
+  where ty  = setRdrNameSpace x tcClsName
+
+
+
 \end{code}