Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Use HsTupleTy [] for unit tuples, uniformly

This is just a tidy-up triggered by #5719.  We were parsing () as a
type constructor, rather than as a HsTupleTy, but it's better dealt
with uniformly as the former, I think.  Somewhat a matter of taste.
  • Loading branch information...
commit 416c5903f3b8cf4cdd4a03c8949489df18cd790a 1 parent 8785726
simonpj authored December 23, 2011
13  compiler/hsSyn/HsTypes.lhs
@@ -195,6 +195,19 @@ mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
195 195
 mkHsOpTy ty1 op ty2 = HsOpTy ty1 (WpKiApps [], op) ty2
196 196
 \end{code}
197 197
 
  198
+Note [Unit tuples]
  199
+~~~~~~~~~~~~~~~~~~
  200
+Consider the type
  201
+    type instance F Int = ()
  202
+We want to parse that "()" 
  203
+    as HsTupleTy HsBoxedOrConstraintTuple [], 
  204
+NOT as HsTyVar unitTyCon
  205
+
  206
+Why? Because F might have kind (* -> Constraint), so we when parsing we
  207
+don't know if that tuple is going to be a constraint tuple or an ordinary
  208
+unit tuple.  The HsTupleSort flag is specifically designed to deal with
  209
+that, but it has to work for unit tuples too.
  210
+
198 211
 Note [Promotions (HsTyVar)]
199 212
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
200 213
 HsTyVar: A name in a type or kind.
30  compiler/parser/Parser.y.pp
@@ -1047,20 +1047,22 @@
1047 1047
         | atype                         { $1 }
1048 1048
 
1049 1049
 atype :: { LHsType RdrName }
1050  
-        : gtycon                        { L1 (HsTyVar (unLoc $1)) }
1051  
-        | tyvar                         { L1 (HsTyVar (unLoc $1)) }
1052  
-        | strict_mark atype             { LL (HsBangTy (unLoc $1) $2) }  -- Constructor sigs only
1053  
-        | '{' fielddecls '}'            {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only
1054  
-        | '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy HsBoxedOrConstraintTuple  ($2:$4) }
1055  
-        | '(#' comma_types1 '#)'        { LL $ HsTupleTy HsUnboxedTuple $2     }
1056  
-        | '[' ctype ']'                 { LL $ HsListTy  $2 }
1057  
-        | '[:' ctype ':]'               { LL $ HsPArrTy  $2 }
1058  
-        | '(' ctype ')'                 { LL $ HsParTy   $2 }
1059  
-        | '(' ctype '::' kind ')'       { LL $ HsKindSig $2 $4 }
1060  
-        | quasiquote                    { L1 (HsQuasiQuoteTy (unLoc $1)) }
1061  
-        | '$(' exp ')'                  { LL $ mkHsSpliceTy $2 }
1062  
-        | TH_ID_SPLICE                  { LL $ mkHsSpliceTy $ L1 $ HsVar $
1063  
-                                          mkUnqual varName (getTH_ID_SPLICE $1) }
  1050
+        : ntgtycon                       { L1 (HsTyVar (unLoc $1)) }      -- Not including unit tuples
  1051
+        | tyvar                          { L1 (HsTyVar (unLoc $1)) }      -- (See Note [Unit tuples])
  1052
+        | strict_mark atype              { LL (HsBangTy (unLoc $1) $2) }  -- Constructor sigs only
  1053
+        | '{' fielddecls '}'             {% checkRecordSyntax (LL $ HsRecTy $2) } -- Constructor sigs only
  1054
+        | '(' ')'                        { LL $ HsTupleTy HsBoxedOrConstraintTuple []      }
  1055
+        | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy HsBoxedOrConstraintTuple ($2:$4) }
  1056
+        | '(#' '#)'                      { LL $ HsTupleTy HsUnboxedTuple           []      }       
  1057
+        | '(#' comma_types1 '#)'         { LL $ HsTupleTy HsUnboxedTuple           $2      }
  1058
+        | '[' ctype ']'                  { LL $ HsListTy  $2 }
  1059
+        | '[:' ctype ':]'                { LL $ HsPArrTy  $2 }
  1060
+        | '(' ctype ')'                  { LL $ HsParTy   $2 }
  1061
+        | '(' ctype '::' kind ')'        { LL $ HsKindSig $2 $4 }
  1062
+        | quasiquote                     { L1 (HsQuasiQuoteTy (unLoc $1)) }
  1063
+        | '$(' exp ')'                   { LL $ mkHsSpliceTy $2 }
  1064
+        | TH_ID_SPLICE                   { LL $ mkHsSpliceTy $ L1 $ HsVar $
  1065
+                                           mkUnqual varName (getTH_ID_SPLICE $1) }
1064 1066
                                                       -- see Note [Promotion] for the followings
1065 1067
         | SIMPLEQUOTE qconid                          { LL $ HsTyVar $ unLoc $2 }
1066 1068
         | SIMPLEQUOTE  '(' ')'                        { LL $ HsTyVar $ getRdrName unitDataCon }
22  compiler/parser/RdrHsSyn.lhs
@@ -56,7 +56,7 @@ import BasicTypes       ( maxPrecedence, Activation(..), RuleMatchInfo,
56 56
                           InlinePragma(..), InlineSpec(..) )
57 57
 import TcEvidence       ( idHsWrapper )
58 58
 import Lexer
59  
-import TysWiredIn       ( unitTyCon )
  59
+import TysWiredIn       ( unitTyCon, unitDataCon )
60 60
 import ForeignCall
61 61
 import OccName          ( srcDataName, varName, isDataOcc, isTcOcc,
62 62
                           occNameString )
@@ -360,10 +360,12 @@ splitCon :: LHsType RdrName
360 360
 splitCon ty
361 361
  = split ty []
362 362
  where
363  
-   split (L _ (HsAppTy t u)) ts = split t (u : ts)
364  
-   split (L l (HsTyVar tc))  ts = do data_con <- tyConToDataCon l tc
365  
-                                     return (data_con, mk_rest ts)
366  
-   split (L l _) _              = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
  363
+   split (L _ (HsAppTy t u)) ts    = split t (u : ts)
  364
+   split (L l (HsTyVar tc))  ts    = do data_con <- tyConToDataCon l tc
  365
+                                        return (data_con, mk_rest ts)
  366
+   split (L l (HsTupleTy _ [])) [] = return (L l (getRdrName unitDataCon), PrefixCon [])
  367
+                                         -- See Note [Unit tuples] in HsTypes
  368
+   split (L l _) _                 = parseErrorSDoc l (text "parse error in constructor in data/newtype declaration:" <+> ppr ty)
367 369
 
368 370
    mk_rest [L _ (HsRecTy flds)] = RecCon flds
369 371
    mk_rest ts                   = PrefixCon ts
@@ -535,12 +537,13 @@ checkTyClHdr ty
535 537
     goL (L l ty) acc = go l ty acc
536 538
 
537 539
     go l (HsTyVar tc) acc 
538  
-        | isRdrTc tc         = return (L l tc, acc)
539  
-                                     
  540
+        | isRdrTc tc          = return (L l tc, acc)
540 541
     go _ (HsOpTy t1 (_, ltc@(L _ tc)) t2) acc
541 542
         | isRdrTc tc         = return (ltc, t1:t2:acc)
542 543
     go _ (HsParTy ty)    acc = goL ty acc
543 544
     go _ (HsAppTy t1 t2) acc = goL t1 (t2:acc)
  545
+    go l (HsTupleTy _ []) [] = return (L l (getRdrName unitTyCon), [])
  546
+                                   -- See Note [Unit tuples] in HsTypes
544 547
     go l _               _   = parseErrorSDoc l (text "Malformed head of type or class declaration:" <+> ppr ty)
545 548
 
546 549
 -- Check that associated type declarations of a class are all kind signatures.
@@ -560,14 +563,11 @@ checkContext (L l orig_t)
560 563
   = check orig_t
561 564
  where
562 565
   check (HsTupleTy _ ts)        -- (Eq a, Ord b) shows up as a tuple type
563  
-    = return (L l ts)
  566
+    = return (L l ts)           -- Ditto ()
564 567
 
565 568
   check (HsParTy ty)    -- to be sure HsParTy doesn't get into the way
566 569
     = check (unLoc ty)
567 570
 
568  
-  check (HsTyVar t)     -- Empty context shows up as a unit type ()
569  
-    | t == getRdrName unitTyCon = return (L l [])
570  
-
571 571
   check _
572 572
     = return (L l [L l orig_t])
573 573
 
12  compiler/typecheck/TcHsType.lhs
@@ -349,14 +349,10 @@ kc_hs_type (HsParTy ty) exp_kind = do
349 349
    ty' <- kc_lhs_type ty exp_kind
350 350
    return (HsParTy ty')
351 351
 
352  
-kc_hs_type (HsTyVar name) exp_kind
353  
-  -- Special case for the unit tycon so it benefits from kind overloading
354  
-  | name == tyConName unitTyCon
355  
-  = kc_hs_type (HsTupleTy HsBoxedOrConstraintTuple []) exp_kind
356  
-  | otherwise = do 
357  
-      (ty, k) <- kcTyVar name
358  
-      checkExpectedKind ty k exp_kind
359  
-      return ty
  352
+kc_hs_type (HsTyVar name) exp_kind = do
  353
+   (ty, k) <- kcTyVar name
  354
+   checkExpectedKind ty k exp_kind
  355
+   return ty
360 356
 
361 357
 kc_hs_type (HsListTy ty) exp_kind = do
362 358
     ty' <- kcLiftedType ty

0 notes on commit 416c590

Please sign in to comment.
Something went wrong with that request. Please try again.