Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
cdd7fdac
Commit
cdd7fdac
authored
Jul 09, 2007
by
Ian Lynagh
Browse files
Implement unboxed tuples flags
-XUnboxedTuples -XExpressionSignaturesUnboxedTuples -XTypeSynonymUnboxedTuples
parent
a4980c2c
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
cdd7fdac
...
...
@@ -175,6 +175,9 @@ data DynFlag
|
Opt_Generics
|
Opt_ImplicitPrelude
|
Opt_ScopedTypeVariables
|
Opt_UnboxedTuples
|
Opt_ExpressionSignaturesUnboxedTuples
|
Opt_TypeSynonymUnboxedTuples
|
Opt_BangPatterns
|
Opt_TypeFamilies
|
Opt_OverloadedStrings
...
...
@@ -1158,6 +1161,9 @@ xFlags = [
(
"ExtendedDefaultRules"
,
Opt_ExtendedDefaultRules
),
(
"ImplicitParams"
,
Opt_ImplicitParams
),
(
"ScopedTypeVariables"
,
Opt_ScopedTypeVariables
),
(
"UnboxedTuples"
,
Opt_UnboxedTuples
),
(
"ExpressionSignaturesUnboxedTuples"
,
Opt_ExpressionSignaturesUnboxedTuples
),
(
"TypeSynonymUnboxedTuples"
,
Opt_TypeSynonymUnboxedTuples
),
(
"TypeSynonymInstances"
,
Opt_TypeSynonymInstances
),
(
"FlexibleContexts"
,
Opt_FlexibleContexts
),
(
"FlexibleInstances"
,
Opt_FlexibleInstances
),
...
...
@@ -1180,6 +1186,9 @@ glasgowExtsFlags = [ Opt_GlasgowExts
,
Opt_GADTs
,
Opt_ImplicitParams
,
Opt_ScopedTypeVariables
,
Opt_UnboxedTuples
,
Opt_ExpressionSignaturesUnboxedTuples
,
Opt_TypeSynonymUnboxedTuples
,
Opt_TypeSynonymInstances
,
Opt_FlexibleContexts
,
Opt_FlexibleInstances
...
...
compiler/parser/Lexer.x
View file @
cdd7fdac
...
...
@@ -308,9 +308,14 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") }
\? @varid / { ifExtension ipEnabled } { skip_one_varid ITdupipvarid }
}
<0,glaexts> {
"(#" / { ifExtension unboxedTuplesEnabled `alexAndPred` notFollowedBySymbol }
{ token IToubxparen }
"#)" / { ifExtension unboxedTuplesEnabled }
{ token ITcubxparen }
}
<glaexts> {
"(#" / { notFollowedBySymbol } { token IToubxparen }
"#)" { token ITcubxparen }
"{|" { token ITocurlybar }
"|}" { token ITccurlybar }
}
...
...
@@ -1525,6 +1530,7 @@ 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
unboxedTuplesBit = 15 -- (# and #)
glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
always _ = True
...
...
@@ -1542,6 +1548,7 @@ magicHashEnabled flags = testBit flags magicHashBit
kindSigsEnabled flags = testBit flags kindSigsBit
recursiveDoEnabled flags = testBit flags recursiveDoBit
unicodeSyntaxEnabled flags = testBit flags unicodeSyntaxBit
unboxedTuplesEnabled flags = testBit flags unboxedTuplesBit
-- PState for parsing options pragmas
--
...
...
@@ -1599,6 +1606,7 @@ mkPState buf loc flags =
.|. kindSigsBit `setBitIf` dopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` dopt Opt_RecursiveDo flags
.|. unicodeSyntaxBit `setBitIf` dopt Opt_UnicodeSyntax flags
.|. unboxedTuplesBit `setBitIf` dopt Opt_UnboxedTuples flags
--
setBitIf :: Int -> Bool -> Int
b `setBitIf` cond | cond = bit b
...
...
compiler/typecheck/TcMType.lhs
View file @
cdd7fdac
...
...
@@ -694,7 +694,8 @@ checkValidType :: UserTypeCtxt -> Type -> TcM ()
-- Checks that the type is valid for the given context
checkValidType ctxt ty
= traceTc (text "checkValidType" <+> ppr ty) `thenM_`
doptM Opt_GlasgowExts `thenM` \ gla_exts ->
doptM Opt_ExpressionSignaturesUnboxedTuples `thenM` \ exp_sigs_unboxed ->
doptM Opt_TypeSynonymUnboxedTuples `thenM` \ type_synonym_unboxed ->
doptM Opt_Rank2Types `thenM` \ rank2 ->
doptM Opt_RankNTypes `thenM` \ rankn ->
doptM Opt_PolymorphicComponents `thenM` \ polycomp ->
...
...
@@ -729,14 +730,10 @@ checkValidType ctxt ty
ForSigCtxt _ -> isLiftedTypeKind actual_kind
other -> isSubArgTypeKind actual_kind
ubx_tup | not gla_exts = UT_NotOk
| otherwise = case ctxt of
TySynCtxt _ -> UT_Ok
ExprSigCtxt -> UT_Ok
other -> UT_NotOk
-- Unboxed tuples ok in function results,
-- but for type synonyms we allow them even at
-- top level
ubx_tup = case ctxt of
TySynCtxt _ | type_synonym_unboxed -> UT_Ok
ExprSigCtxt | exp_sigs_unboxed -> UT_Ok
_ -> UT_NotOk
in
-- Check that the thing has kind Type, and is lifted if necessary
checkTc kind_ok (kindErr actual_kind) `thenM_`
...
...
@@ -857,8 +854,8 @@ check_tau_type rank ubx_tup ty@(TyConApp tc tys)
}
| isUnboxedTupleTyCon tc
= doptM Opt_
GlasgowExts `thenM` \ gla_exts
->
checkTc (ubx_tup_ok
gla_exts
) ubx_tup_msg `thenM_`
= doptM Opt_
UnboxedTuples `thenM` \ ub_tuples_allowed
->
checkTc (ubx_tup_ok
ub_tuples_allowed
) ubx_tup_msg `thenM_`
mappM_ (check_tau_type (Rank 0) UT_Ok) tys
-- Args are allowed to be unlifted, or
-- more unboxed tuples, so can't use check_arg_ty
...
...
@@ -867,7 +864,7 @@ check_tau_type rank ubx_tup ty@(TyConApp tc tys)
= mappM_ check_arg_type tys
where
ubx_tup_ok
gla_exts
= case ubx_tup of { UT_Ok ->
gla_exts
; other -> False }
ubx_tup_ok
ub_tuples_allowed
= case ubx_tup of { UT_Ok ->
ub_tuples_allowed
; other -> False }
n_args = length tys
tc_arity = tyConArity tc
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment