Commit dff3e914 authored by Ian Lynagh's avatar Ian Lynagh

Implement -XUnicodeSyntax

parent aa529d34
......@@ -187,6 +187,7 @@ data DynFlag
| Opt_FlexibleInstances
| Opt_MultiParamTypeClasses
| Opt_FunctionalDependencies
| Opt_UnicodeSyntax
| Opt_MagicHash
| Opt_EmptyDataDecls
| Opt_KindSignatures
......@@ -1107,6 +1108,7 @@ xFlags :: [(String, DynFlag)]
xFlags = [
( "CPP", Opt_Cpp ),
( "PatternGuards", Opt_PatternGuards ),
( "UnicodeSyntax", Opt_UnicodeSyntax ),
( "MagicHash", Opt_MagicHash ),
( "KindSignatures", Opt_KindSignatures ),
( "EmptyDataDecls", Opt_EmptyDataDecls ),
......@@ -1167,6 +1169,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
, Opt_MultiParamTypeClasses
, Opt_FunctionalDependencies
, Opt_MagicHash
, Opt_UnicodeSyntax
, Opt_PatternGuards
, Opt_RankNTypes
, Opt_RecursiveDo
......
......@@ -632,39 +632,43 @@ reservedWordsFM = listToUFM $
( "proc", ITproc, bit arrowsBit)
]
reservedSymsFM :: UniqFM (Token, Int -> Bool)
reservedSymsFM = listToUFM $
map (\ (x,y,z) -> (mkFastString x,(y,z)))
[ ("..", ITdotdot, 0)
,(":", ITcolon, 0) -- (:) is a reserved op,
-- meaning only list cons
,("::", ITdcolon, 0)
,("=", ITequal, 0)
,("\\", ITlam, 0)
,("|", ITvbar, 0)
,("<-", ITlarrow, 0)
,("->", ITrarrow, 0)
,("@", ITat, 0)
,("~", ITtilde, 0)
,("=>", ITdarrow, 0)
,("-", ITminus, 0)
,("!", ITbang, 0)
,("*", ITstar, bit glaExtsBit .|. bit kindSigsBit .|.
bit tyFamBit) -- For data T (a::*) = MkT
,(".", ITdot, bit tvBit) -- For 'forall a . t'
,("-<", ITlarrowtail, bit arrowsBit)
,(">-", ITrarrowtail, bit arrowsBit)
,("-<<", ITLarrowtail, bit arrowsBit)
,(">>-", ITRarrowtail, bit arrowsBit)
map (\ (x,y,z) -> (mkFastString x,(y,z)))
[ ("..", ITdotdot, always)
-- (:) is a reserved op, meaning only list cons
,(":", ITcolon, always)
,("::", ITdcolon, always)
,("=", ITequal, always)
,("\\", ITlam, always)
,("|", ITvbar, always)
,("<-", ITlarrow, always)
,("->", ITrarrow, always)
,("@", ITat, always)
,("~", ITtilde, always)
,("=>", ITdarrow, always)
,("-", ITminus, always)
,("!", ITbang, always)
-- For data T (a::*) = MkT
,("*", ITstar, \i -> glaExtsEnabled i ||
kindSigsEnabled i ||
tyFamEnabled i)
-- For 'forall a . t'
,(".", ITdot, tvEnabled)
,("-<", ITlarrowtail, arrowsEnabled)
,(">-", ITrarrowtail, arrowsEnabled)
,("-<<", ITLarrowtail, arrowsEnabled)
,(">>-", ITRarrowtail, arrowsEnabled)
#if __GLASGOW_HASKELL__ >= 605
,("∷", ITdcolon, bit glaExtsBit)
,("⇒", ITdarrow, bit glaExtsBit)
,("∀", ITforall, bit glaExtsBit)
,("→", ITrarrow, bit glaExtsBit)
,("←", ITlarrow, bit glaExtsBit)
,("⋯", ITdotdot, bit glaExtsBit)
,("∷", ITdcolon, unicodeSyntaxEnabled)
,("⇒", ITdarrow, unicodeSyntaxEnabled)
,("∀", ITforall, \i -> unicodeSyntaxEnabled i && tvEnabled i)
,("→", ITrarrow, unicodeSyntaxEnabled)
,("←", ITlarrow, unicodeSyntaxEnabled)
,("⋯", ITdotdot, unicodeSyntaxEnabled)
-- ToDo: ideally, → and ∷ should be "specials", so that they cannot
-- form part of a large operator. This would let us have a better
-- syntax for kinds: ɑ∷*→* would be a legal kind signature. (maybe).
......@@ -943,9 +947,8 @@ consym = sym ITconsym
sym con span buf len =
case lookupUFM reservedSymsFM fs of
Just (keyword,0) -> return (L span keyword)
Just (keyword,exts) -> do
b <- extension (\i -> exts .&. i /= 0)
b <- extension exts
if b then return (L span keyword)
else return (L span $! con fs)
_other -> return (L span $! con fs)
......@@ -1520,8 +1523,10 @@ haddockBit = 10 -- Lex and parse Haddock comments
magicHashBit = 11 -- # in both functions and operators
kindSigsBit = 12 -- Kind signatures on type variables
recursiveDoBit = 13 -- mdo
unicodeSyntaxBit = 14 -- the forall symbol, arrow symbols, etc
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
always _ = True
glaExtsEnabled flags = testBit flags glaExtsBit
ffiEnabled flags = testBit flags ffiBit
parrEnabled flags = testBit flags parrBit
......@@ -1535,6 +1540,7 @@ haddockEnabled flags = testBit flags haddockBit
magicHashEnabled flags = testBit flags magicHashBit
kindSigsEnabled flags = testBit flags kindSigsBit
recursiveDoEnabled flags = testBit flags recursiveDoBit
unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
-- PState for parsing options pragmas
--
......@@ -1589,6 +1595,7 @@ mkPState buf loc flags =
.|. magicHashBit `setBitIf` dopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
.|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment