X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=3958b9cf9a74d878db0885dc6ca8e7d40dcb3bb1;hp=a0cc96417c862044228212b0ff685617ffd8e31e;hb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;hpb=cb8fb4dc68b503474bd65c0a669d9018a3ce96fe

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index a0cc964..3958b9c 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -39,7 +39,7 @@ import Type		( funTyCon )
 import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
 			  CCallConv(..), CCallTarget(..), defaultCCallConv
 			)
-import OccName		( varName, dataName, tcClsName, tvName )
+import OccName		( varName, varNameDepth, dataName, tcClsName, tvName )
 import DataCon		( DataCon, dataConName )
 import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
 			  SrcSpan, combineLocs, srcLocFile, 
@@ -304,6 +304,11 @@ incorrect.
  '#)'		{ L _ ITcubxparen }
  '(|'		{ L _ IToparenbar }
  '|)'		{ L _ ITcparenbar }
+ '<['		{ L _ ITopenBrak }
+ ']>'		{ L _ ITcloseBrak }
+ '~~'		{ L _ ITescape }
+ '~~$'		{ L _ ITescapeDollar }
+ '%%'		{ L _ ITdoublePercent }
  ';'		{ L _ ITsemi }
  ','		{ L _ ITcomma }
  '`'		{ L _ ITbackquote }
@@ -1011,6 +1016,7 @@ atype :: { LHsType RdrName }
 	| '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
 	| '(#' comma_types1 '#)'	{ LL $ HsTupleTy Unboxed $2     }
 	| '[' ctype ']'			{ LL $ HsListTy  $2 }
+	| '<[' ctype ']>' '@' tyvar     { LL $ HsModalBoxType (unLoc $5) $2 }
 	| '[:' ctype ':]'		{ LL $ HsPArrTy  $2 }
 	| '(' ctype ')'		        { LL $ HsParTy   $2 }
 	| '(' ctype '::' kind ')'	{ LL $ HsKindSig $2 (unLoc $4) }
@@ -1214,6 +1220,7 @@ decl 	:: { Located (OrdList (LHsDecl RdrName)) }
         | infixexp opt_sig rhs  {% do { r <- checkValDef $1 $2 $3;
                                         let { l = comb2 $1 $> };
                                         return $! (sL l (unitOL $! (sL l $ ValD r))) } }
+
         | docdecl               { LL $ unitOL $1 }
 
 rhs	:: { Located (GRHSs RdrName) }
@@ -1231,6 +1238,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
 	: infixexp '::' sigtypedoc	{% do s <- checkValSig $1 $3 
 				         ; return (LL $ unitOL (LL $ SigD s)) }
 		-- See Note [Declaration/signature overlap] for why we need infixexp here
+
 	| var ',' sig_vars '::' sigtypedoc
 				{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
 	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
@@ -1255,6 +1263,10 @@ quasiquote :: { Located (HsQuasiQuote RdrName) }
                                 ; quoterId = mkUnqual varName quoter }
                             in L1 (mkHsQuasiQuote quoterId quoteSpan quote) }
 
+incdepth :: { Located () } :  {% do { incrBracketDepth ; return $ noLoc () } }
+decdepth :: { Located () } :  {% do { decrBracketDepth ; return $ noLoc () } }
+
+
 exp   :: { LHsExpr RdrName }
 	: infixexp '::' sigtype		{ LL $ ExprWithTySig $1 $3 }
 	| infixexp '-<' exp		{ LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
@@ -1262,6 +1274,7 @@ exp   :: { LHsExpr RdrName }
 	| infixexp '-<<' exp		{ LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
 	| infixexp '>>-' exp		{ LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
 	| infixexp			{ $1 }
+	| '~~$' decdepth exp incdepth	{ sL (comb2 $3 $>) (HsHetMetEsc placeHolderType placeHolderType $3) }
 
 infixexp :: { LHsExpr RdrName }
 	: exp10				{ $1 }
@@ -1392,6 +1405,11 @@ aexp2	:: { LHsExpr RdrName }
 	-- arrow notation extension
 	| '(|' aexp2 cmdargs '|)'	{ LL $ HsArrForm $2 Nothing (reverse $3) }
 
+ 	-- code type notation extension
+	| '<[' incdepth exp  decdepth ']>'	{ sL (comb2 $3 $>) (HsHetMetBrak placeHolderType                 $3) }
+	| '~~' decdepth aexp incdepth 		{ sL (comb2 $3 $>) (HsHetMetEsc  placeHolderType placeHolderType $3) }
+	| '%%' decdepth aexp incdepth		{ sL (comb2 $3 $>) (HsHetMetCSP  placeHolderType                 $3) }
+
 cmdargs	:: { [LHsCmdTop RdrName] }
 	: cmdargs acmd			{ $2 : $1 }
   	| {- empty -}			{ [] }
@@ -1823,7 +1841,7 @@ qvarid :: { Located RdrName }
         | PREFIXQVARSYM         { L1 $! mkQual varName (getPREFIXQVARSYM $1) }
 
 varid :: { Located RdrName }
-	: VARID			{ L1 $! mkUnqual varName (getVARID $1) }
+	: VARID			{% do { depth <- getParserBrakDepth ; return (L1 $! mkUnqual (varNameDepth depth) (getVARID $1)) } }
 	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
 	| 'unsafe'		{ L1 $! mkUnqual varName (fsLit "unsafe") }
 	| 'safe'		{ L1 $! mkUnqual varName (fsLit "safe") }
@@ -1848,9 +1866,10 @@ varsym :: { Located RdrName }
 	| '-'			{ L1 $ mkUnqual varName (fsLit "-") }
 
 varsym_no_minus :: { Located RdrName } -- varsym not including '-'
-	: VARSYM		{ L1 $ mkUnqual varName (getVARSYM $1) }
-	| special_sym		{ L1 $ mkUnqual varName (unLoc $1) }
-
+	: VARSYM		{% do { depth <- getParserBrakDepth
+                                      ; return (L1 $! mkUnqual (varNameDepth depth) (getVARSYM $1)) } }
+	| special_sym		{% do { depth <- getParserBrakDepth
+                                      ; return (L1 $! mkUnqual (varNameDepth depth) (unLoc $1)) } }
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these