Allow any as name of hole

3 files changed, 23 insertions, 21 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index cc5878a8e5..fd1f9efefa 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -382,9 +382,9 @@ $tab          { warnTab }
   "$$("       / { ifExtension ThBit }       { token ITparenTyEscape }
 
   "_("        / { ifExtension EthBit }     { token ITopenTypedHole }
-  \) $decdigit $decdigit*
+  \) $idchar $idchar*
     / { ifExtension EthBit }
-    { skip_one_decimal ITcloseTypedHole }
+    { skip_one_varid ITcloseTypedHole }
   "_$("
     / { ifExtension EthBit `alexAndPred`
         ifExtension ThBit }
@@ -796,7 +796,7 @@ data Token
 
   -- Typed-holes
   | ITopenTypedHole              -- ^ _(
-  | ITcloseTypedHole Integer     -- ^ )0
+  | ITcloseTypedHole FastString  -- ^ )0 or )varid
   | ITopenTypedHoleEscape        -- ^ _$(
   | ITopenTypedHoleTyEscape      -- ^ _$$(
 
@@ -965,10 +965,6 @@ skip_two_varid :: (FastString -> Token) -> Action
 skip_two_varid f span buf len
   = return (L span $! f (lexemeToFastString (stepOn (stepOn buf)) (len-2)))
 
-skip_one_decimal :: (Integer -> Token) -> Action
-skip_one_decimal f span buf len
-  = return $ L span $! f (parseUnsignedInteger (stepOn buf) (len-1) 10 octDecDigit)
-
 strtoken :: (String -> Token) -> Action
 strtoken f span buf len =
   return (L span $! (f $! lexemeToString buf len))
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 2b2f71368d..9bd1946efe 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -616,10 +616,10 @@ TH_TY_QUOTE     { L _ ITtyQuote       }      -- ''T
 TH_QUASIQUOTE   { L _ (ITquasiQuote _) }
 TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
 
- '_('           { L _ ITopenTypedHole }
- CLOSE_HOLE     { L _ (ITcloseTypedHole _) }
- '_$('          { L _ ITopenTypedHoleEscape }
- '_$$('         { L _ ITopenTypedHoleTyEscape }
+'_('           { L _ ITopenTypedHole }
+CLOSE_HOLE     { L _ (ITcloseTypedHole _) }
+'_$('          { L _ ITopenTypedHoleEscape }
+'_$$('         { L _ ITopenTypedHoleTyEscape }
 
 %monad { P } { >>= } { return }
 %lexer { (lexer True) } { L _ ITeof }
@@ -2868,7 +2868,7 @@ infix_extended_typed_hole :: { forall b. DisambInfixOp b => PV (Located b) }
                                                              [mj AnnBackquote $1, mj AnnBackquote $3 ] }
 
 
-typed_hole_splice :: { (Located (Maybe Integer), Located (HsSplice GhcPs) ) }
+typed_hole_splice :: { (Located (Maybe FastString), Located (HsSplice GhcPs) ) }
         : '_$('  exp hole_close    {% runECP_P $2
                                     >>= \ $2 -> ams (sLL $1 $> $ mkUntypedSplice HasParens $2)
                                                     [mj AnnOpenHolePE $1,mj AnnCloseHoleP $3]
@@ -2878,7 +2878,7 @@ typed_hole_splice :: { (Located (Maybe Integer), Located (HsSplice GhcPs) ) }
                                                     [mj AnnOpenHolePE $1,mj AnnCloseHoleP $3]
                                     >>= \ $2 -> return ($3, $2) }
 
-hole_close :: { Located (Maybe Integer) }
+hole_close :: { Located (Maybe FastString) }
   : ')'           {% ams (sL1 $1 Nothing) [mj AnnCloseHoleP $1] }
   | CLOSE_HOLE     {% ams (sL1 $1 $ Just $ getCLOSE_HOLE $1) [mj AnnCloseHoleP $1] }
 
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index cc905e81ab..c2bf0b3e0e 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -1839,8 +1839,14 @@ class DisambInfixOp b where
   mkHsVarOpPV :: Located RdrName -> PV (Located b)
   mkHsConOpPV :: Located RdrName -> PV (Located b)
   mkHsInfixHolePV :: SrcSpan -> PV (Located b)
-  mkHsExtInfixHolePV :: SrcSpan -> Located (Maybe Integer) -> Maybe (Located FastString) -> PV (Located b)
-  mkHsExtInfixHoleSplicePV :: SrcSpan -> Located (Maybe Integer) -> Located (HsSplice GhcPs) -> PV (Located b)
+  mkHsExtInfixHolePV :: SrcSpan
+                     -> Located (Maybe FastString)
+                     -> Maybe (Located FastString)
+                     -> PV (Located b)
+  mkHsExtInfixHoleSplicePV :: SrcSpan
+                           -> Located (Maybe FastString)
+                           -> Located (HsSplice GhcPs)
+                           -> PV (Located b)
 
 instance p ~ GhcPs => DisambInfixOp (HsExpr p) where
   mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExtField v)
@@ -1910,8 +1916,8 @@ class b ~ (Body b) GhcPs => DisambECP b where
   -- | Disambiguate a wildcard
   mkHsWildCardPV :: SrcSpan -> PV (Located b)
   -- | An extended hole _(...), _$(...) or _$$(...)
-  mkHsExtHolePV :: SrcSpan -> Located (Maybe Integer) -> Maybe (Located FastString) -> PV (Located b)
-  mkHsExtHoleSplicePV :: SrcSpan -> Located (Maybe Integer) -> Located (HsSplice GhcPs) -> PV (Located b)
+  mkHsExtHolePV :: SrcSpan -> Located (Maybe FastString) -> Maybe (Located FastString) -> PV (Located b)
+  mkHsExtHoleSplicePV :: SrcSpan -> Located (Maybe FastString) -> Located (HsSplice GhcPs) -> PV (Located b)
   -- | Disambiguate "a :: t" (type annotation)
   mkHsTySigPV :: SrcSpan -> Located b -> LHsType GhcPs -> PV (Located b)
   -- | Disambiguate "[a,b,c]" (list syntax)
@@ -2097,19 +2103,19 @@ hsHoleExpr :: HsExpr (GhcPass id)
 hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_"))
 
 -- See Note [Extended Typed-Holes]
-hsExtHoleExpr :: Located (Maybe Integer)
+hsExtHoleExpr :: Located (Maybe FastString)
               -> Maybe (Located FastString)
               -> HsExpr (GhcPass id)
 hsExtHoleExpr hid fs =
       HsExtendedHole noExtField (ExtendedHole (mkVarOcc ("_(...)" ++ i)) fs)
-  where i = maybe "" show $ unLoc hid
+  where i = maybe "" unpackFS $ unLoc hid
 
-hsExtHoleSpliceExpr :: Located (Maybe Integer)
+hsExtHoleSpliceExpr :: Located (Maybe FastString)
                     -> Located (HsSplice (GhcPass p))
                     -> HsExpr (GhcPass p)
 hsExtHoleSpliceExpr hid lspl@(L _ spl) =
    HsExtendedHole noExtField $ ExtendedHoleSplice (mkVarOcc $ pat ++ i) lexpr
-    where i = maybe "" show $ unLoc hid
+    where i = maybe "" unpackFS $ unLoc hid
           lexpr = mapLoc (HsSpliceE noExtField) lspl
           pat = case spl of
                   HsUntypedSplice{} -> "_$(...)"