From abc32aba7135136c89e089296e296fbb380bda39 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Mon, 22 Sep 2008 15:23:40 +0000 Subject: [PATCH] add -XNewQualifiedOperators (Haskell' qualified operator syntax) --- compiler/main/DynFlags.hs | 4 +- compiler/parser/Lexer.x | 49 +++++++++++++++++------ compiler/parser/Parser.y.pp | 18 +++++---- docs/users_guide/glasgow_exts.xml | 79 +++++++++++++++++++++++++++++++++---- 4 files changed, 121 insertions(+), 29 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c75510b..bf6d11a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -240,6 +240,7 @@ data DynFlag | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PackageImports + | Opt_NewQualifiedOperators | Opt_PrintExplicitForalls @@ -1661,7 +1662,8 @@ xFlags = [ ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ), ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ), - ( "PackageImports", Opt_PackageImports, const Supported ) + ( "PackageImports", Opt_PackageImports, const Supported ), + ( "NewQualifiedOperators", Opt_NewQualifiedOperators, const Supported ) ] impliedFlags :: [(DynFlag, DynFlag)] diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 613848a..fd680bc 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -20,6 +20,17 @@ -- - M... should be 3 tokens, not 1. -- - pragma-end should be only valid in a pragma +-- qualified operator NOTES. +-- +-- - If M.(+) is a single lexeme, then.. +-- - Probably (+) should be a single lexeme too, for consistency. +-- Otherwise ( + ) would be a prefix operator, but M.( + ) would not be. +-- - But we have to rule out reserved operators, otherwise (..) becomes +-- a different lexeme. +-- - Should we therefore also rule out reserved operators in the qualified +-- form? This is quite difficult to achieve. We don't do it for +-- qualified varids. + { {-# OPTIONS -w #-} -- The above warning supression flag is a temporary kludge. @@ -365,13 +376,15 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } @conid "#"+ / { ifExtension magicHashEnabled } { idtoken conid } } --- ToDo: M.(,,,) - +-- ToDo: - move `var` and (sym) into lexical syntax? +-- - remove backquote from $special? <0> { - @qual @varsym { idtoken qvarsym } - @qual @consym { idtoken qconsym } - @varsym { varsym } - @consym { consym } + @qual @varsym / { ifExtension oldQualOps } { idtoken qvarsym } + @qual @consym / { ifExtension oldQualOps } { idtoken qconsym } + @qual \( @varsym \) / { ifExtension newQualOps } { idtoken prefixqvarsym } + @qual \( @consym \) / { ifExtension newQualOps } { idtoken prefixqconsym } + @varsym { varsym } + @consym { consym } } -- For the normal boxed literals we need to be careful @@ -527,6 +540,8 @@ data Token | ITqconid (FastString,FastString) | ITqvarsym (FastString,FastString) | ITqconsym (FastString,FastString) + | ITprefixqvarsym (FastString,FastString) + | ITprefixqconsym (FastString,FastString) | ITdupipvarid FastString -- GHC extension: implicit param: ?x @@ -924,14 +939,14 @@ close_brace span _str _len = do popContext return (L span ITccurly) -qvarid buf len = ITqvarid $! splitQualName buf len -qconid buf len = ITqconid $! splitQualName buf len +qvarid buf len = ITqvarid $! splitQualName buf len False +qconid buf len = ITqconid $! splitQualName buf len False -splitQualName :: StringBuffer -> Int -> (FastString,FastString) +splitQualName :: StringBuffer -> Int -> Bool -> (FastString,FastString) -- takes a StringBuffer and a length, and returns the module name -- and identifier parts of a qualified name. Splits at the *last* dot, -- because of hierarchical module names. -splitQualName orig_buf len = split orig_buf orig_buf +splitQualName orig_buf len parens = split orig_buf orig_buf where split buf dot_buf | orig_buf `byteDiff` buf >= len = done dot_buf @@ -951,7 +966,9 @@ splitQualName orig_buf len = split orig_buf orig_buf done dot_buf = (lexemeToFastString orig_buf (qual_size - 1), - lexemeToFastString dot_buf (len - qual_size)) + if parens -- Prelude.(+) + then lexemeToFastString (stepOn dot_buf) (len - qual_size - 2) + else lexemeToFastString dot_buf (len - qual_size)) where qual_size = orig_buf `byteDiff` dot_buf @@ -973,8 +990,10 @@ varid span buf len = conid buf len = ITconid fs where fs = lexemeToFastString buf len -qvarsym buf len = ITqvarsym $! splitQualName buf len -qconsym buf len = ITqconsym $! splitQualName buf len +qvarsym buf len = ITqvarsym $! splitQualName buf len False +qconsym buf len = ITqconsym $! splitQualName buf len False +prefixqvarsym buf len = ITprefixqvarsym $! splitQualName buf len True +prefixqconsym buf len = ITprefixqconsym $! splitQualName buf len True varsym = sym ITvarsym consym = sym ITconsym @@ -1609,6 +1628,7 @@ transformComprehensionsBit = 17 qqBit = 18 -- enable quasiquoting inRulePragBit = 19 rawTokenStreamBit = 20 -- producing a token stream with all comments included +newQualOpsBit = 21 -- Haskell' qualified operator syntax, e.g. Prelude.(+) genericsEnabled, ffiEnabled, parrEnabled :: Int -> Bool always _ = True @@ -1632,6 +1652,8 @@ transformComprehensionsEnabled flags = testBit flags transformComprehensionsBit qqEnabled flags = testBit flags qqBit inRulePrag flags = testBit flags inRulePragBit rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit +newQualOps flags = testBit flags newQualOpsBit +oldQualOps flags = not (newQualOps flags) -- PState for parsing options pragmas -- @@ -1695,6 +1717,7 @@ mkPState buf loc flags = .|. standaloneDerivingBit `setBitIf` dopt Opt_StandaloneDeriving flags .|. transformComprehensionsBit `setBitIf` dopt Opt_TransformListComp flags .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags + .|. newQualOpsBit `setBitIf` dopt Opt_NewQualifiedOperators flags -- setBitIf :: Int -> Bool -> Int b `setBitIf` cond | cond = bit b diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index b51edf2..2f1166d 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -314,6 +314,8 @@ incorrect. QCONID { L _ (ITqconid _) } QVARSYM { L _ (ITqvarsym _) } QCONSYM { L _ (ITqconsym _) } + PREFIXQVARSYM { L _ (ITprefixqvarsym _) } + PREFIXQCONSYM { L _ (ITprefixqconsym _) } IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension @@ -1739,6 +1741,7 @@ qtyconop :: { Located RdrName } -- Qualified or unqualified qtycon :: { Located RdrName } -- Qualified or unqualified : QCONID { L1 $! mkQual tcClsName (getQCONID $1) } + | PREFIXQCONSYM { L1 $! mkQual tcClsName (getPREFIXQCONSYM $1) } | tycon { $1 } tycon :: { Located RdrName } -- Unqualified @@ -1819,17 +1822,15 @@ qvar :: { Located RdrName } qvarid :: { Located RdrName } : varid { $1 } - | QVARID { L1 $ mkQual varName (getQVARID $1) } + | QVARID { L1 $! mkQual varName (getQVARID $1) } + | PREFIXQVARSYM { L1 $! mkQual varName (getPREFIXQVARSYM $1) } varid :: { Located RdrName } - : varid_no_unsafe { $1 } + : VARID { L1 $! mkUnqual varName (getVARID $1) } + | special_id { L1 $! mkUnqual varName (unLoc $1) } | 'unsafe' { L1 $! mkUnqual varName (fsLit "unsafe") } | 'safe' { L1 $! mkUnqual varName (fsLit "safe") } | 'threadsafe' { L1 $! mkUnqual varName (fsLit "threadsafe") } - -varid_no_unsafe :: { Located RdrName } - : VARID { L1 $! mkUnqual varName (getVARID $1) } - | special_id { L1 $! mkUnqual varName (unLoc $1) } | 'forall' { L1 $! mkUnqual varName (fsLit "forall") } | 'family' { L1 $! mkUnqual varName (fsLit "family") } @@ -1878,7 +1879,8 @@ special_sym : '!' { L1 (fsLit "!") } qconid :: { Located RdrName } -- Qualified or unqualified : conid { $1 } - | QCONID { L1 $ mkQual dataName (getQCONID $1) } + | QCONID { L1 $! mkQual dataName (getQCONID $1) } + | PREFIXQCONSYM { L1 $! mkQual dataName (getPREFIXQCONSYM $1) } conid :: { Located RdrName } : CONID { L1 $ mkUnqual dataName (getCONID $1) } @@ -1987,6 +1989,8 @@ getQVARID (L _ (ITqvarid x)) = x getQCONID (L _ (ITqconid x)) = x getQVARSYM (L _ (ITqvarsym x)) = x getQCONSYM (L _ (ITqconsym x)) = x +getPREFIXQVARSYM (L _ (ITprefixqvarsym x)) = x +getPREFIXQCONSYM (L _ (ITprefixqconsym x)) = x getIPDUPVARID (L _ (ITdupipvarid x)) = x getCHAR (L _ (ITchar x)) = x getSTRING (L _ (ITstring x)) = x diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index ba18faf..782bc57 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -52,16 +52,42 @@ documentation describes all the libraries that come with GHC. Language options recognised by Cabal can also be enabled using the LANGUAGE pragma, thus {-# LANGUAGE TemplateHaskell #-} (see >). - The flag : + The flag - simultaneously enables the following extensions: - , - , - , - , - . + is equivalent to enabling the following extensions: + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + , + . Enabling these options is the only - effect of -fglasgow-exts + effect of -fglasgow-exts. We are trying to move away from this portmanteau flag, and towards enabling features individually. @@ -339,6 +365,43 @@ Indeed, the bindings can even be recursive. + + New qualified operator syntax + + A new syntax for referencing qualified operators is + planned to be introduced by Haskell', and is enabled in GHC + with + the + option. In the new syntax, the prefix form of a qualified + operator is + written module.(symbol) + (in Haskell 98 this would + be (module.symbol)), + and the infix form is + written `module.(symbol)` + (in Haskell 98 this would + be `module.symbol`. + For example: + + add x y = Prelude.(+) x y + subtract y = (`Prelude.(-)` y) + + The new form of qualified operators is intended to regularise + the syntax by eliminating odd cases + like Prelude... For example, + when NewQualifiedOperators is on, it is possible to + write the enerated sequence [Monday..] + without spaces, whereas in Haskell 98 this would be a + reference to the operator ‘.‘ + from module Monday. + + When is on, the old Haskell + 98 syntax for qualified operators is not accepted, so this + option may cause existing Haskell 98 code to break. + + + + -- 1.7.10.4