diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index b7a7545..97c6507 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -204,11 +204,13 @@ fixing them in the syntax but leaving them till the semantic checking
 = Public API
 
 > -- | Parses a query expr, trailing semicolon optional.
-> parseQueryExpr :: FilePath
->                   -- ^ filename to use in errors
+> parseQueryExpr :: Dialect
+>                   -- ^ dialect of SQL to use
+>                -> FilePath
+>                   -- ^ filename to use in error messages
 >                -> Maybe (Int,Int)
 >                   -- ^ line number and column number of the first character
->                   -- in the source (to use in errors)
+>                   -- in the source to use in error messages
 >                -> String
 >                   -- ^ the SQL source to parse
 >                -> Either ParseError QueryExpr
@@ -216,22 +218,26 @@ fixing them in the syntax but leaving them till the semantic checking
 
 > -- | Parses a list of query expressions, with semi colons between
 > -- them. The final semicolon is optional.
-> parseQueryExprs :: FilePath
->                    -- ^ filename to use in errors
+> parseQueryExprs :: Dialect
+>                   -- ^ dialect of SQL to use
+>                 -> FilePath
+>                    -- ^ filename to use in error messages
 >                 -> Maybe (Int,Int)
 >                    -- ^ line number and column number of the first character
->                    -- in the source (to use in errors)
+>                    -- in the source to use in error messages
 >                 -> String
 >                    -- ^ the SQL source to parse
 >                 -> Either ParseError [QueryExpr]
 > parseQueryExprs = wrapParse queryExprs
 
 > -- | Parses a value expression.
-> parseValueExpr :: FilePath
->                    -- ^ filename to use in errors
+> parseValueExpr :: Dialect
+>                    -- ^ dialect of SQL to use
+>                 -> FilePath
+>                    -- ^ filename to use in error messages
 >                 -> Maybe (Int,Int)
 >                    -- ^ line number and column number of the first character
->                    -- in the source (to use in errors)
+>                    -- in the source to use in error messages
 >                 -> String
 >                    -- ^ the SQL source to parse
 >                 -> Either ParseError ValueExpr
@@ -245,11 +251,12 @@ checks the parser parses all the input using eof
 converts the error return to the nice wrapper
 
 > wrapParse :: Parser a
+>           -> Dialect
 >           -> FilePath
 >           -> Maybe (Int,Int)
 >           -> String
 >           -> Either ParseError a
-> wrapParse parser f p src =
+> wrapParse parser _ f p src =
 >     either (Left . convParseError src) Right
 >     $ parse (setPos p *> whitespace *> parser <* eof) f src
 >   where
@@ -296,7 +303,12 @@ u&"example quoted"
 > name :: Parser Name
 > name = choice [QName <$> quotedIdentifier
 >               ,UQName <$> uquotedIdentifier
->               ,Name <$> identifierBlacklist blacklist]
+>               ,Name <$> identifierBlacklist blacklist
+>               ,dqName]
+>   where
+>     dqName = lexeme (DQName "`" "`"
+>                      <$> (char '`'
+>                           *> manyTill anyChar (char '`')))
 
 todo: replace (:[]) with a named function all over
 
@@ -1289,10 +1301,13 @@ allows offset and fetch in either order
 >                               ,keyword_ "row"])
 
 > fetch :: Parser ValueExpr
-> fetch = fs *> valueExpr <* ro
+> fetch = fetchFirst <|> limit
 >   where
+>     fetchFirst = fs *> valueExpr <* ro
 >     fs = makeKeywordTree ["fetch first", "fetch next"]
 >     ro = makeKeywordTree ["rows only", "row only"]
+>     -- todo: not in ansi sql dialect
+>     limit = keyword_ "limit" *> valueExpr
 
 == common table expressions
 
@@ -1971,4 +1986,6 @@ means).
 >     ,"within"
 >     ,"without"
 >     --,"year"
+>      -- added for mysql dialect, todo: make dialect specific lists
+>     ,"limit"
 >     ]
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index c04965e..cdb3a75 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -19,17 +19,17 @@ which have been changed to try to improve the layout of the output.
 > import Data.List (intercalate)
 
 > -- | Convert a query expr ast to concrete syntax.
-> prettyQueryExpr :: QueryExpr -> String
-> prettyQueryExpr = render . queryExpr
+> prettyQueryExpr :: Dialect -> QueryExpr -> String
+> prettyQueryExpr _ = render . queryExpr
 
 > -- | Convert a value expr ast to concrete syntax.
-> prettyValueExpr :: ValueExpr -> String
-> prettyValueExpr = render . valueExpr
+> prettyValueExpr :: Dialect -> ValueExpr -> String
+> prettyValueExpr _ = render . valueExpr
 
 > -- | Convert a list of query exprs to concrete syntax. A semi colon
 > -- is inserted after each query expr.
-> prettyQueryExprs :: [QueryExpr] -> String
-> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr)
+> prettyQueryExprs :: Dialect -> [QueryExpr] -> String
+> prettyQueryExprs _ = render . vcat . map ((<> text ";\n") . queryExpr)
 
 = value expressions
 
@@ -248,6 +248,7 @@ which have been changed to try to improve the layout of the output.
 > name (UQName n) =
 >     text "U&" <> doubleQuotes (text $ doubleUpDoubleQuotes n)
 > name (Name n) = text n
+> name (DQName s e n) = text s <> text n <> text e
 
 > names :: [Name] -> Doc
 > names ns = hcat $ punctuate (text ".") $ map name ns
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index a0af988..87ac07c 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -30,6 +30,8 @@
 >     ,TableRef(..)
 >     ,JoinType(..)
 >     ,JoinCondition(..)
+>      -- * dialect
+>     ,Dialect(..)
 >     ) where
 
 > import Data.Data
@@ -165,6 +167,8 @@
 > data Name = Name String
 >           | QName String
 >           | UQName String
+>           | DQName String String String
+>             -- ^ dialect quoted name, the fields are start quote, end quote and the string itself, e.g. `something` is parsed to DQName "`" "`" "something, and $a$ test $a$ is parsed to DQName "$a$" "$a" " test "
 >             deriving (Eq,Show,Read,Data,Typeable)
 
 > -- | Represents a type name, used in casts.
@@ -372,3 +376,10 @@ I'm not sure if this is valid syntax or not.
 > data JoinCondition = JoinOn ValueExpr -- ^ on expr
 >                    | JoinUsing [Name] -- ^ using (column list)
 >                      deriving (Eq,Show,Read,Data,Typeable)
+
+
+> -- | Used to set the dialect used for parsing and pretty printing,
+> -- very unfinished at the moment.
+> data Dialect = SQL2011
+>              | MySQL
+>                deriving (Eq,Show,Read,Data,Typeable)
diff --git a/TODO b/TODO
index 432ddf6..889a8d0 100644
--- a/TODO
+++ b/TODO
@@ -1,8 +1,13 @@
 work on reasonable subset of sql which is similar to the current
    subset and smaller than the complete 2011 target
-prototype for dialect handling
+prototype for dialect handling, todo:
+  add test which test for failure
+  test that mysql specific syntax fails on ansi mode
+    and that the ansi equivalents of the mysql specific syntax which
+    has been implemented fail in mysql mode
 position annotation
 
+simple stuff for error message and pretty printing monitoring
 
 work on the new refactoring of the parser
 create a new module for generic combinators
diff --git a/changelog b/changelog
index 282e517..446ebfc 100644
--- a/changelog
+++ b/changelog
@@ -1,8 +1,9 @@
 If you need help updating to a new version of simple-sql-parser,
 please email jakewheatmail@gmail.com or use the github bug tracker,
 https://github.com/JakeWheat/simple-sql-parser/issues.
-
-0.4.0 (updated to dbd48baaa1d1bce3d0d0139b8ffe55370fabe672)
+0.4.1 (unreleased)
+	simple demonstration of how dialects could be handled internally
+0.4.0 (commit 7914898cc8f07bbaf8358d208469392346341964)
 	now targets SQL:2011
 	update to ghc 7.8.2
 	remove dependency on haskell-src-exts
diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal
index 4051d2a..21f8aec 100644
--- a/simple-sql-parser.cabal
+++ b/simple-sql-parser.cabal
@@ -1,5 +1,5 @@
 name:                simple-sql-parser
-version:             0.4.0
+version:             0.4.1
 synopsis:            A parser for SQL queries
 
 description:         A parser for SQL queries. Parses most SQL:2011
@@ -64,6 +64,7 @@ Test-Suite Tests
                        Language.SQL.SimpleSQL.ErrorMessages,
                        Language.SQL.SimpleSQL.FullQueries,
                        Language.SQL.SimpleSQL.GroupBy,
+                       Language.SQL.SimpleSQL.MySQL,
                        Language.SQL.SimpleSQL.Postgres,
                        Language.SQL.SimpleSQL.QueryExprComponents,
                        Language.SQL.SimpleSQL.QueryExprs,
diff --git a/tools/Language/SQL/SimpleSQL/FullQueries.lhs b/tools/Language/SQL/SimpleSQL/FullQueries.lhs
index cfc0504..6b1bbe8 100644
--- a/tools/Language/SQL/SimpleSQL/FullQueries.lhs
+++ b/tools/Language/SQL/SimpleSQL/FullQueries.lhs
@@ -8,7 +8,7 @@ Some tests for parsing full queries.
 
 
 > fullQueriesTests :: TestItem
-> fullQueriesTests = Group "queries" $ map (uncurry TestQueryExpr)
+> fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select count(*) from t"
 >      ,makeSelect
 >       {qeSelectList = [(App [Name "count"] [Star], Nothing)]
diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.lhs b/tools/Language/SQL/SimpleSQL/GroupBy.lhs
index d1495b6..340b5c5 100644
--- a/tools/Language/SQL/SimpleSQL/GroupBy.lhs
+++ b/tools/Language/SQL/SimpleSQL/GroupBy.lhs
@@ -15,7 +15,7 @@ Here are the tests for the group by component of query exprs
 >     ]
 
 > simpleGroupBy :: TestItem
-> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry TestQueryExpr)
+> simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a,sum(b) from t group by a"
 >      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
 >                                  ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]
@@ -37,7 +37,7 @@ test the new group by (), grouping sets, cube and rollup syntax (not
 sure which sql version they were introduced, 1999 or 2003 I think).
 
 > newGroupBy :: TestItem
-> newGroupBy = Group "newGroupBy" $ map (uncurry TestQueryExpr)
+> newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from t group by ()", ms [GroupingParens []])
 >     ,("select * from t group by grouping sets ((), (a))"
 >      ,ms [GroupingSets [GroupingParens []
@@ -53,7 +53,7 @@ sure which sql version they were introduced, 1999 or 2003 I think).
 >                       ,qeGroupBy = g}
 
 > randomGroupBy :: TestItem
-> randomGroupBy = Group "randomGroupBy" $ map ParseQueryExpr
+> randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr SQL2011)
 >     ["select * from t GROUP BY a"
 >     ,"select * from t GROUP BY GROUPING SETS((a))"
 >     ,"select * from t GROUP BY a,b,c"
diff --git a/tools/Language/SQL/SimpleSQL/MySQL.lhs b/tools/Language/SQL/SimpleSQL/MySQL.lhs
new file mode 100644
index 0000000..1556a99
--- /dev/null
+++ b/tools/Language/SQL/SimpleSQL/MySQL.lhs
@@ -0,0 +1,36 @@
+
+Tests for mysql dialect parsing
+
+> module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
+
+> import Language.SQL.SimpleSQL.TestTypes
+> import Language.SQL.SimpleSQL.Syntax
+
+> mySQLTests :: TestItem
+> mySQLTests = Group "mysql dialect"
+>     [backtickQuotes
+>     ,limit]
+
+backtick quotes
+
+limit syntax
+
+[LIMIT {[offset,] row_count | row_count OFFSET offset}]
+
+> backtickQuotes :: TestItem
+> backtickQuotes = Group "backtickQuotes" $ map (uncurry (TestValueExpr MySQL))
+>     [("`test`", Iden [DQName "`" "`" "test"])
+>     ]
+
+
+> limit :: TestItem
+> limit = Group "queries" $ map (uncurry (TestQueryExpr MySQL))
+>     [("select * from t limit 5"
+>      ,sel {qeFetchFirst = Just (NumLit "5")}
+>      )
+>     ]
+>   where
+>     sel = makeSelect
+>           {qeSelectList = [(Star, Nothing)]
+>           ,qeFrom = [TRSimple [Name "t"]]
+>           }
diff --git a/tools/Language/SQL/SimpleSQL/Postgres.lhs b/tools/Language/SQL/SimpleSQL/Postgres.lhs
index 19b1807..209f522 100644
--- a/tools/Language/SQL/SimpleSQL/Postgres.lhs
+++ b/tools/Language/SQL/SimpleSQL/Postgres.lhs
@@ -6,10 +6,9 @@ revisited when the dialect support is added.
 > module Language.SQL.SimpleSQL.Postgres (postgresTests) where
 
 > import Language.SQL.SimpleSQL.TestTypes
-> --import Language.SQL.SimpleSQL.Syntax
 
 > postgresTests :: TestItem
-> postgresTests = Group "postgresTests" $ map ParseQueryExpr
+> postgresTests = Group "postgresTests" $ map (ParseQueryExpr SQL2011)
 
 lexical syntax section
 
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
index f2377ca..7427bc3 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprComponents.lhs
@@ -28,7 +28,7 @@ These are a few misc tests which don't fit anywhere else.
 
 
 > duplicates :: TestItem
-> duplicates = Group "duplicates" $ map (uncurry TestQueryExpr)
+> duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t" ,ms SQDefault)
 >     ,("select all a from t" ,ms All)
 >     ,("select distinct a from t", ms Distinct)
@@ -40,7 +40,7 @@ These are a few misc tests which don't fit anywhere else.
 >           ,qeFrom = [TRSimple [Name "t"]]}
 
 > selectLists :: TestItem
-> selectLists = Group "selectLists" $ map (uncurry TestQueryExpr)
+> selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select 1",
 >       makeSelect {qeSelectList = [(NumLit "1",Nothing)]})
 
@@ -73,7 +73,7 @@ These are a few misc tests which don't fit anywhere else.
 >     ]
 
 > whereClause :: TestItem
-> whereClause = Group "whereClause" $ map (uncurry TestQueryExpr)
+> whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t where a = 5"
 >      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)]
 >                  ,qeFrom = [TRSimple [Name "t"]]
@@ -81,7 +81,7 @@ These are a few misc tests which don't fit anywhere else.
 >     ]
 
 > having :: TestItem
-> having = Group "having" $ map (uncurry TestQueryExpr)
+> having = Group "having" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a,sum(b) from t group by a having sum(b) > 5"
 >      ,makeSelect {qeSelectList = [(Iden [Name "a"],Nothing)
 >                                  ,(App [Name "sum"] [Iden [Name "b"]],Nothing)]
@@ -93,7 +93,7 @@ These are a few misc tests which don't fit anywhere else.
 >     ]
 
 > orderBy :: TestItem
-> orderBy = Group "orderBy" $ map (uncurry TestQueryExpr)
+> orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t order by a"
 >      ,ms [SortSpec (Iden [Name "a"]) DirDefault NullsOrderDefault])
 
@@ -119,7 +119,7 @@ These are a few misc tests which don't fit anywhere else.
 >                       ,qeOrderBy = o}
 
 > offsetFetch :: TestItem
-> offsetFetch = Group "offsetFetch" $ map (uncurry TestQueryExpr)
+> offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr SQL2011))
 >     [-- ansi standard
 >      ("select a from t offset 5 rows fetch next 10 rows only"
 >      ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
@@ -142,7 +142,7 @@ These are a few misc tests which don't fit anywhere else.
 >              ,qeFetchFirst = l}
 
 > combos :: TestItem
-> combos = Group "combos" $ map (uncurry TestQueryExpr)
+> combos = Group "combos" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t union select b from u"
 >      ,CombineQueryExpr ms1 Union SQDefault Respectively ms2)
 
@@ -173,7 +173,7 @@ These are a few misc tests which don't fit anywhere else.
 
 
 > withQueries :: TestItem
-> withQueries = Group "with queries" $ map (uncurry TestQueryExpr)
+> withQueries = Group "with queries" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("with u as (select a from t) select a from u"
 >      ,With False [(Alias (Name "u") Nothing, ms1)] ms2)
 
@@ -197,13 +197,13 @@ These are a few misc tests which don't fit anywhere else.
 >    ms3 = ms "a" "x"
 
 > values :: TestItem
-> values = Group "values" $ map (uncurry TestQueryExpr)
+> values = Group "values" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("values (1,2),(3,4)"
 >       ,Values [[NumLit "1", NumLit "2"]
 >               ,[NumLit "3", NumLit "4"]])
 >     ]
 
 > tables :: TestItem
-> tables = Group "tables" $ map (uncurry TestQueryExpr)
+> tables = Group "tables" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("table tbl", Table [Name "tbl"])
 >     ]
diff --git a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
index 5eea1d6..3c62a3b 100644
--- a/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/QueryExprs.lhs
@@ -8,7 +8,7 @@ query expressions from one string.
 > import Language.SQL.SimpleSQL.Syntax
 
 > queryExprsTests :: TestItem
-> queryExprsTests = Group "query exprs" $ map (uncurry TestQueryExprs)
+> queryExprsTests = Group "query exprs" $ map (uncurry (TestQueryExprs SQL2011))
 >     [("select 1",[ms])
 >     ,("select 1;",[ms])
 >     ,("select 1;select 1",[ms,ms])
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011.lhs b/tools/Language/SQL/SimpleSQL/SQL2011.lhs
index 34e7c7b..882e9f3 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011.lhs
@@ -482,7 +482,7 @@ Specify a non-null value.
 
 > characterStringLiterals :: TestItem
 > characterStringLiterals = Group "character string literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("'a regular string literal'"
 >      ,StringLit "a regular string literal")
 >     ,("'something' ' some more' 'and more'"
@@ -510,7 +510,7 @@ character set allows them.
 
 > nationalCharacterStringLiterals :: TestItem
 > nationalCharacterStringLiterals = Group "national character string literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("N'something'", CSStringLit "N" "something")
 >     ,("n'something'", CSStringLit "n" "something")
 >     ]
@@ -527,7 +527,7 @@ character set allows them.
 
 > unicodeCharacterStringLiterals :: TestItem
 > unicodeCharacterStringLiterals = Group "unicode character string literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("U&'something'", CSStringLit "U&" "something")
 >     ,("u&'something' escape ="
 >      ,Escape (CSStringLit "u&" "something") '=')
@@ -546,7 +546,7 @@ TODO: unicode escape
 
 > binaryStringLiterals :: TestItem
 > binaryStringLiterals = Group "binary string literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [--("B'101010'", CSStringLit "B" "101010")
 >      ("X'7f7f7f'", CSStringLit "X" "7f7f7f")
 >     ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
@@ -576,7 +576,7 @@ TODO: unicode escape
 
 > numericLiterals :: TestItem
 > numericLiterals = Group "numeric literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("11", NumLit "11")
 >     ,("11.11", NumLit "11.11")
 
@@ -682,7 +682,7 @@ TODO: unicode escape
 
 > intervalLiterals :: TestItem
 > intervalLiterals = Group "intervalLiterals literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("interval '1'", TypedLit (TypeName [Name "interval"]) "1")
 >     ,("interval '1' day"
 >      ,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)
@@ -705,7 +705,7 @@ TODO: unicode escape
 
 > booleanLiterals :: TestItem
 > booleanLiterals = Group "boolean literals"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("true", Iden [Name "true"])
 >     ,("false", Iden [Name "false"])
 >     ,("unknown", Iden [Name "unknown"])
@@ -725,7 +725,7 @@ Specify names.
 
 > identifiers :: TestItem
 > identifiers = Group "identifiers"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("test",Iden [Name "test"])
 >     ,("_test",Iden [Name "_test"])
 >     ,("t1",Iden [Name "t1"])
@@ -1166,7 +1166,7 @@ Now test each variation in both cast expression and typed literal
 expression
 
 > typeNameTests :: TestItem
-> typeNameTests = Group "type names" $ map (uncurry TestValueExpr)
+> typeNameTests = Group "type names" $ map (uncurry (TestValueExpr SQL2011))
 >     $ concatMap makeTests typeNames
 >   where
 >     makeTests (ctn, stn) =
@@ -1184,7 +1184,7 @@ Define a field of a row type.
 
 > fieldDefinition :: TestItem
 > fieldDefinition = Group "field definition"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("cast('(1,2)' as row(a int,b char))"
 >      ,Cast (StringLit "(1,2)")
 >      $ RowTypeName [(Name "a", TypeName [Name "int"])
@@ -1264,7 +1264,7 @@ Specify a value that is syntactically self-delimited.
 
 > parenthesizedValueExpression :: TestItem
 > parenthesizedValueExpression = Group "parenthesized value expression"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("(3)", Parens (NumLit "3"))
 >     ,("((3))", Parens $ Parens (NumLit "3"))
 >     ]
@@ -1300,7 +1300,7 @@ Specify one or more values, host parameters, SQL parameters, dynamic parameters,
 
 > generalValueSpecification :: TestItem
 > generalValueSpecification = Group "general value specification"
->     $ map (uncurry TestValueExpr) $
+>     $ map (uncurry (TestValueExpr SQL2011)) $
 >     map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
 >                ,"CURRENT_PATH"
 >                ,"CURRENT_ROLE"
@@ -1354,7 +1354,7 @@ TODO: add the missing bits
 
 > parameterSpecification :: TestItem
 > parameterSpecification = Group "parameter specification"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [(":hostparam", HostParameter "hostparam" Nothing)
 >     ,(":hostparam indicator :another_host_param"
 >      ,HostParameter "hostparam" $ Just "another_host_param")
@@ -1391,7 +1391,7 @@ Specify a value whose data type is to be inferred from its context.
 > contextuallyTypedValueSpecification :: TestItem
 > contextuallyTypedValueSpecification =
 >     Group "contextually typed value specification"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("null", Iden [Name "null"])
 >     ,("array[]", Array (Iden [Name "array"]) [])
 >     ,("multiset[]", MultisetCtor [])
@@ -1409,7 +1409,7 @@ Disambiguate a <period>-separated chain of identifiers.
 
 > identifierChain :: TestItem
 > identifierChain = Group "identifier chain"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("a.b", Iden [Name "a",Name "b"])]
 
 == 6.7 <column reference>
@@ -1423,7 +1423,7 @@ Reference a column.
 
 > columnReference :: TestItem
 > columnReference = Group "column reference"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("module.a.b", Iden [Name "module",Name "a",Name "b"])]
 
 == 6.8 <SQL parameter reference>
@@ -1446,7 +1446,7 @@ Specify a value derived by the application of a function to an argument.
 
 > setFunctionSpecification :: TestItem
 > setFunctionSpecification = Group "set function specification"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
 >       \   GROUPING(SalesQuota) AS Grouping\n\
 >       \FROM Sales.SalesPerson\n\
@@ -1647,7 +1647,7 @@ Specify a data conversion.
 
 > castSpecification :: TestItem
 > castSpecification = Group "cast specification"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("cast(a as int)"
 >      ,Cast (Iden [Name "a"]) (TypeName [Name "int"]))
 >     ]
@@ -1661,7 +1661,7 @@ Return the next value of a sequence generator.
 
 > nextValueExpression :: TestItem
 > nextValueExpression = Group "next value expression"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("next value for a.b", NextValueFor [Name "a", Name "b"])
 >     ]
 
@@ -1674,7 +1674,7 @@ Reference a field of a row value.
 
 > fieldReference :: TestItem
 > fieldReference = Group "field reference"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("f(something).a"
 >       ,BinOp (App [Name "f"] [Iden [Name "something"]])
 >        [Name "."]
@@ -1798,7 +1798,7 @@ Return an element of an array.
 
 > arrayElementReference :: TestItem
 > arrayElementReference = Group "array element reference"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("something[3]"
 >      ,Array (Iden [Name "something"]) [NumLit "3"])
 >     ,("(something(a))[x]"
@@ -1821,7 +1821,7 @@ Return the sole element of a multiset of one element.
 
 > multisetElementReference :: TestItem
 > multisetElementReference = Group "multisetElementReference"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("element(something)"
 >      ,App [Name "element"] [Iden [Name "something"]])
 >     ]
@@ -1871,7 +1871,7 @@ Specify a numeric value.
 
 > numericValueExpression :: TestItem
 > numericValueExpression = Group "numeric value expression"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("a + b", binOp "+")
 >     ,("a - b", binOp "-")
 >     ,("a * b", binOp "*")
@@ -2328,7 +2328,7 @@ Specify a boolean value.
 
 > booleanValueExpression :: TestItem
 > booleanValueExpression = Group "booleab value expression"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("a or b", BinOp a [Name "or"] b)
 >     ,("a and b", BinOp a [Name "and"] b)
 >     ,("not a", PrefixOp [Name "not"] a)
@@ -2403,7 +2403,7 @@ Specify construction of an array.
 
 > arrayValueConstructor :: TestItem
 > arrayValueConstructor = Group "array value constructor"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("array[1,2,3]"
 >      ,Array (Iden [Name "array"])
 >       [NumLit "1", NumLit "2", NumLit "3"])
@@ -2441,7 +2441,7 @@ Specify a multiset value.
 
 > multisetValueExpression :: TestItem
 > multisetValueExpression = Group "multiset value expression"
->    $ map (uncurry TestValueExpr)
+>    $ map (uncurry (TestValueExpr SQL2011))
 >    [("a multiset union b"
 >     ,MultisetBinOp (Iden [Name "a"]) Union SQDefault (Iden [Name "b"]))
 >    ,("a multiset union all b"
@@ -2468,7 +2468,7 @@ Specify a function yielding a value of a multiset type.
 
 > multisetValueFunction :: TestItem
 > multisetValueFunction = Group "multiset value function"
->    $ map (uncurry TestValueExpr)
+>    $ map (uncurry (TestValueExpr SQL2011))
 >    [("set(a)", App [Name "set"] [Iden [Name "a"]])
 >    ]
 
@@ -2496,7 +2496,7 @@ Specify construction of a multiset.
 
 > multisetValueConstructor :: TestItem
 > multisetValueConstructor = Group "multiset value constructor"
->    $ map (uncurry TestValueExpr)
+>    $ map (uncurry (TestValueExpr SQL2011))
 >    [("multiset[a,b,c]", MultisetCtor[Iden [Name "a"]
 >                                     ,Iden [Name "b"], Iden [Name "c"]])
 >    ,("multiset(select * from t)", MultisetQueryCtor qe)
@@ -2574,7 +2574,7 @@ Specify a value or list of values to be constructed into a row.
 
 > rowValueConstructor :: TestItem
 > rowValueConstructor = Group "row value constructor"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("(a,b)"
 >      ,SpecialOp [Name "rowctor"] [Iden [Name "a"], Iden [Name "b"]])
 >     ,("row(1)",App [Name "row"] [NumLit "1"])
@@ -2625,7 +2625,7 @@ Specify a set of <row value expression>s to be constructed into a table.
 
 > tableValueConstructor :: TestItem
 > tableValueConstructor = Group "table value constructor"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("values (1,2), (a+b,(select count(*) from t));"
 >      ,Values [[NumLit "1", NumLit "2"]
 >              ,[BinOp (Iden [Name "a"]) [Name "+"]
@@ -2660,7 +2660,7 @@ Specify a table derived from one or more tables.
 
 > fromClause :: TestItem
 > fromClause = Group "fromClause"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from tbl1,tbl2"
 >      ,makeSelect
 >       {qeSelectList = [(Star, Nothing)]
@@ -2675,7 +2675,7 @@ Reference a table.
 
 > tableReference :: TestItem
 > tableReference = Group "table reference"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from t", sel)
 
 <table reference> ::= <table factor> | <joined table>
@@ -2856,7 +2856,7 @@ Specify a table derived from a Cartesian product, inner join, or outer join.
 
 > joinedTable :: TestItem
 > joinedTable = Group "joined table"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from a cross join b"
 >      ,sel $ TRJoin a False JCross b Nothing)
 >     ,("select * from a join b on true"
@@ -2913,7 +2913,7 @@ the result of the preceding <from clause>.
 
 > whereClause :: TestItem
 > whereClause = Group "where clause"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from t where a = 5"
 >     ,makeSelect
 >      {qeSelectList = [(Star,Nothing)]
@@ -2973,7 +2973,7 @@ clause> to the result of the previously specified clause.
 
 > groupByClause :: TestItem
 > groupByClause = Group "group by clause"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a,sum(x) from t group by a"
 >      ,qe [SimpleGroup $ Iden [Name "a"]])
 >      ,("select a,sum(x) from t group by a collate c"
@@ -3021,7 +3021,7 @@ not satisfy a <search condition>.
 
 > havingClause :: TestItem
 > havingClause = Group "having clause"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a,sum(x) from t group by a having sum(x) > 1000"
 >      ,makeSelect
 >       {qeSelectList = [(Iden [Name "a"], Nothing)
@@ -3144,7 +3144,7 @@ Specify a table derived from the result of a <table expression>.
 
 > querySpecification :: TestItem
 > querySpecification = Group "query specification"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t",qe)
 >     ,("select all a from t",qe {qeSetQuantifier = All})
 >     ,("select distinct a from t",qe {qeSetQuantifier = Distinct})
@@ -3212,7 +3212,7 @@ Specify a table.
 
 > setOpQueryExpression :: TestItem
 > setOpQueryExpression= Group "set operation query expression"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     -- todo: complete setop query expression tests
 >     [{-("select * from t union select * from t"
 >      ,undefined)
@@ -3249,7 +3249,7 @@ everywhere
 
 > explicitTableQueryExpression :: TestItem
 > explicitTableQueryExpression= Group "explicit table query expression"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("table t", Table [Name "t"])
 >     ]
 
@@ -3271,7 +3271,7 @@ everywhere
 
 > orderOffsetFetchQueryExpression :: TestItem
 > orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [-- todo: finish tests for order offset and fetch
 >      ("select a from t order by a"
 >      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
@@ -3428,7 +3428,7 @@ Specify a comparison of two row values.
 
 > comparisonPredicates :: TestItem
 > comparisonPredicates = Group "comparison predicates"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     $ map mkOp ["=", "<>", "<", ">", "<=", ">="]
 >     ++ [("ROW(a) = ROW(b)"
 >         ,BinOp (App [Name "ROW"] [a])
@@ -3632,7 +3632,7 @@ Specify a quantified comparison.
 
 > quantifiedComparisonPredicate :: TestItem
 > quantifiedComparisonPredicate = Group "quantified comparison predicate"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 
 >     [("a = any (select * from t)"
 >      ,QuantifiedComparison (Iden [Name "a"]) [Name "="] CPAny qe)
@@ -3659,7 +3659,7 @@ Specify a test for a non-empty set.
 
 > existsPredicate :: TestItem
 > existsPredicate = Group "exists predicate"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("exists(select * from t where a = 4)"
 >      ,SubQueryExpr SqExists
 >       $ makeSelect
@@ -3678,7 +3678,7 @@ Specify a test for the absence of duplicate rows.
 
 > uniquePredicate :: TestItem
 > uniquePredicate = Group "unique predicate"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("unique(select * from t where a = 4)"
 >      ,SubQueryExpr SqUnique
 >       $ makeSelect
@@ -3714,7 +3714,7 @@ Specify a test for matching rows.
 
 > matchPredicate :: TestItem
 > matchPredicate = Group "match predicate"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("a match (select a from t)"
 >      ,Match (Iden [Name "a"]) False qe)
 >     ,("(a,b) match (select a,b from t)"
@@ -4066,7 +4066,7 @@ Specify a default collation.
 
 > collateClause :: TestItem
 > collateClause = Group "collate clause"
->     $ map (uncurry TestValueExpr)
+>     $ map (uncurry (TestValueExpr SQL2011))
 >     [("a collate my_collation"
 >      ,Collate (Iden [Name "a"]) [Name "my_collation"])]
 
@@ -4177,7 +4177,7 @@ Specify a value computed from a collection of rows.
 
 > aggregateFunction :: TestItem
 > aggregateFunction = Group "aggregate function"
->     $ map (uncurry TestValueExpr) $
+>     $ map (uncurry (TestValueExpr SQL2011)) $
 >     [("count(*)",App [Name "count"] [Star])
 >     ,("count(*) filter (where something > 5)"
 >      ,AggregateApp [Name "count"] SQDefault [Star] [] fil)
@@ -4272,7 +4272,7 @@ Specify a sort order.
 
 > sortSpecificationList :: TestItem
 > sortSpecificationList = Group "sort specification list"
->     $ map (uncurry TestQueryExpr)
+>     $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select * from t order by a"
 >      ,qe {qeOrderBy = [SortSpec (Iden [Name "a"])
 >                            DirDefault NullsOrderDefault]})
diff --git a/tools/Language/SQL/SimpleSQL/TableRefs.lhs b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
index b4dfd75..55d4e81 100644
--- a/tools/Language/SQL/SimpleSQL/TableRefs.lhs
+++ b/tools/Language/SQL/SimpleSQL/TableRefs.lhs
@@ -9,7 +9,7 @@ expression
 
 
 > tableRefTests :: TestItem
-> tableRefTests = Group "tableRefTests" $ map (uncurry TestQueryExpr)
+> tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr SQL2011))
 >     [("select a from t"
 >      ,ms [TRSimple [Name "t"]])
 
diff --git a/tools/Language/SQL/SimpleSQL/TestTypes.lhs b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
index 38e9cff..e8f7262 100644
--- a/tools/Language/SQL/SimpleSQL/TestTypes.lhs
+++ b/tools/Language/SQL/SimpleSQL/TestTypes.lhs
@@ -2,18 +2,20 @@
 This is the types used to define the tests as pure data. See the
 Tests.lhs module for the 'interpreter'.
 
-> module Language.SQL.SimpleSQL.TestTypes where
+> module Language.SQL.SimpleSQL.TestTypes
+>     (TestItem(..)
+>     ,Dialect(..)) where
 
 > import Language.SQL.SimpleSQL.Syntax
 
 > data TestItem = Group String [TestItem]
->               | TestValueExpr String ValueExpr
->               | TestQueryExpr String QueryExpr
->               | TestQueryExprs String [QueryExpr]
+>               | TestValueExpr Dialect String ValueExpr
+>               | TestQueryExpr Dialect String QueryExpr
+>               | TestQueryExprs Dialect String [QueryExpr]
 
 this just checks the sql parses without error, mostly just a
 intermediate when I'm too lazy to write out the parsed AST. These
 should all be TODO to convert to a testqueryexpr test.
 
->               | ParseQueryExpr String
+>               | ParseQueryExpr Dialect String
 >                 deriving (Eq,Show)
diff --git a/tools/Language/SQL/SimpleSQL/Tests.lhs b/tools/Language/SQL/SimpleSQL/Tests.lhs
index 2c13421..5f06c8c 100644
--- a/tools/Language/SQL/SimpleSQL/Tests.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tests.lhs
@@ -30,6 +30,8 @@ test data to the Test.Framework tests.
 
 > import Language.SQL.SimpleSQL.SQL2011
 
+> import Language.SQL.SimpleSQL.MySQL
+
 Order the tests to start from the simplest first. This is also the
 order on the generated documentation.
 
@@ -45,6 +47,7 @@ order on the generated documentation.
 >     ,postgresTests
 >     ,tpchTests
 >     ,sql2011Tests
+>     ,mySQLTests
 >     ]
 
 > tests :: Test.Framework.Test
@@ -56,29 +59,30 @@ order on the generated documentation.
 > itemToTest :: TestItem -> Test.Framework.Test
 > itemToTest (Group nm ts) =
 >     testGroup nm $ map itemToTest ts
-> itemToTest (TestValueExpr str expected) =
->     toTest parseValueExpr prettyValueExpr str expected
-> itemToTest (TestQueryExpr str expected) =
->     toTest parseQueryExpr prettyQueryExpr str expected
-> itemToTest (TestQueryExprs str expected) =
->     toTest parseQueryExprs prettyQueryExprs str expected
-> itemToTest (ParseQueryExpr str) =
->     toPTest parseQueryExpr prettyQueryExpr str
+> itemToTest (TestValueExpr d str expected) =
+>     toTest parseValueExpr prettyValueExpr d str expected
+> itemToTest (TestQueryExpr d str expected) =
+>     toTest parseQueryExpr prettyQueryExpr d str expected
+> itemToTest (TestQueryExprs d str expected) =
+>     toTest parseQueryExprs prettyQueryExprs d str expected
+> itemToTest (ParseQueryExpr d str) =
+>     toPTest parseQueryExpr prettyQueryExpr d str
 
 > toTest :: (Eq a, Show a) =>
->           (String -> Maybe (Int,Int) -> String -> Either ParseError a)
->        -> (a -> String)
+>           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
+>        -> (Dialect -> a -> String)
+>        -> Dialect
 >        -> String
 >        -> a
 >        -> Test.Framework.Test
-> toTest parser pp str expected = testCase str $ do
->         let egot = parser "" Nothing str
+> toTest parser pp d str expected = testCase str $ do
+>         let egot = parser d "" Nothing str
 >         case egot of
 >             Left e -> H.assertFailure $ peFormattedError e
 >             Right got -> do
 >                 H.assertEqual "" expected got
->                 let str' = pp got
->                 let egot' = parser "" Nothing str'
+>                 let str' = pp d got
+>                 let egot' = parser d "" Nothing str'
 >                 case egot' of
 >                     Left e' -> H.assertFailure $ "pp roundtrip"
 >                                                  ++ "\n" ++ str'
@@ -88,17 +92,18 @@ order on the generated documentation.
 >                                    expected got'
 
 > toPTest :: (Eq a, Show a) =>
->           (String -> Maybe (Int,Int) -> String -> Either ParseError a)
->        -> (a -> String)
+>           (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
+>        -> (Dialect -> a -> String)
+>        -> Dialect
 >        -> String
 >        -> Test.Framework.Test
-> toPTest parser pp str = testCase str $ do
->         let egot = parser "" Nothing str
+> toPTest parser pp d str = testCase str $ do
+>         let egot = parser d "" Nothing str
 >         case egot of
 >             Left e -> H.assertFailure $ peFormattedError e
 >             Right got -> do
->                 let str' = pp got
->                 let egot' = parser "" Nothing str'
+>                 let str' = pp d got
+>                 let egot' = parser d "" Nothing str'
 >                 case egot' of
 >                     Left e' -> H.assertFailure $ "pp roundtrip "
 >                                                  ++ "\n" ++ str' ++ "\n"
diff --git a/tools/Language/SQL/SimpleSQL/Tpch.lhs b/tools/Language/SQL/SimpleSQL/Tpch.lhs
index b069e7f..9b2c051 100644
--- a/tools/Language/SQL/SimpleSQL/Tpch.lhs
+++ b/tools/Language/SQL/SimpleSQL/Tpch.lhs
@@ -13,7 +13,7 @@ The changes made to the official syntax are:
 > tpchTests :: TestItem
 > tpchTests =
 >     Group "parse tpch"
->     $ map (ParseQueryExpr . snd) tpchQueries
+>     $ map (ParseQueryExpr SQL2011 . snd) tpchQueries
 
 > tpchQueries :: [(String,String)]
 > tpchQueries =
diff --git a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
index 523dc70..86e5c7a 100644
--- a/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
+++ b/tools/Language/SQL/SimpleSQL/ValueExprs.lhs
@@ -23,7 +23,7 @@ Tests for parsing value expressions
 >     ]
 
 > literals :: TestItem
-> literals = Group "literals" $ map (uncurry TestValueExpr)
+> literals = Group "literals" $ map (uncurry (TestValueExpr SQL2011))
 >     [("3", NumLit "3")
 >      ,("3.", NumLit "3.")
 >      ,("3.3", NumLit "3.3")
@@ -45,27 +45,27 @@ Tests for parsing value expressions
 >     ]
 
 > identifiers :: TestItem
-> identifiers = Group "identifiers" $ map (uncurry TestValueExpr)
+> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr SQL2011))
 >     [("iden1", Iden [Name "iden1"])
 >     --,("t.a", Iden2 "t" "a")
 >     ,("\"quoted identifier\"", Iden [QName "quoted identifier"])
 >     ]
 
 > star :: TestItem
-> star = Group "star" $ map (uncurry TestValueExpr)
+> star = Group "star" $ map (uncurry (TestValueExpr SQL2011))
 >     [("*", Star)
 >     --,("t.*", Star2 "t")
 >     --,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
 >     ]
 
 > parameter :: TestItem
-> parameter = Group "parameter" $ map (uncurry TestValueExpr)
+> parameter = Group "parameter" $ map (uncurry (TestValueExpr SQL2011))
 >     [("?", Parameter)
 >     ]
 
 
 > dots :: TestItem
-> dots = Group "dot" $ map (uncurry TestValueExpr)
+> dots = Group "dot" $ map (uncurry (TestValueExpr SQL2011))
 >     [("t.a", Iden [Name "t",Name "a"])
 >     ,("t.*", BinOp (Iden [Name "t"]) [Name "."] Star)
 >     ,("a.b.c", Iden [Name "a",Name "b",Name "c"])
@@ -73,14 +73,14 @@ Tests for parsing value expressions
 >     ]
 
 > app :: TestItem
-> app = Group "app" $ map (uncurry TestValueExpr)
+> app = Group "app" $ map (uncurry (TestValueExpr SQL2011))
 >     [("f()", App [Name "f"] [])
 >     ,("f(a)", App [Name "f"] [Iden [Name "a"]])
 >     ,("f(a,b)", App [Name "f"] [Iden [Name "a"], Iden [Name "b"]])
 >     ]
 
 > caseexp :: TestItem
-> caseexp = Group "caseexp" $ map (uncurry TestValueExpr)
+> caseexp = Group "caseexp" $ map (uncurry (TestValueExpr SQL2011))
 >     [("case a when 1 then 2 end"
 >      ,Case (Just $ Iden [Name "a"]) [([NumLit "1"]
 >                               ,NumLit "2")] Nothing)
@@ -116,7 +116,7 @@ Tests for parsing value expressions
 >     ,miscOps]
 
 > binaryOperators :: TestItem
-> binaryOperators = Group "binaryOperators" $ map (uncurry TestValueExpr)
+> binaryOperators = Group "binaryOperators" $ map (uncurry (TestValueExpr SQL2011))
 >     [("a + b", BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"]))
 >      -- sanity check fixities
 >      -- todo: add more fixity checking
@@ -131,7 +131,7 @@ Tests for parsing value expressions
 >     ]
 
 > unaryOperators :: TestItem
-> unaryOperators = Group "unaryOperators" $ map (uncurry TestValueExpr)
+> unaryOperators = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
 >     [("not a", PrefixOp [Name "not"] $ Iden [Name "a"])
 >     ,("not not a", PrefixOp [Name "not"] $ PrefixOp [Name "not"] $ Iden [Name "a"])
 >     ,("+a", PrefixOp [Name "+"] $ Iden [Name "a"])
@@ -140,7 +140,7 @@ Tests for parsing value expressions
 
 
 > casts :: TestItem
-> casts = Group "operators" $ map (uncurry TestValueExpr)
+> casts = Group "operators" $ map (uncurry (TestValueExpr SQL2011))
 >     [("cast('1' as int)"
 >      ,Cast (StringLit "1") $ TypeName [Name "int"])
 
@@ -162,7 +162,7 @@ Tests for parsing value expressions
 >     ]
 
 > subqueries :: TestItem
-> subqueries = Group "unaryOperators" $ map (uncurry TestValueExpr)
+> subqueries = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
 >     [("exists (select a from t)", SubQueryExpr SqExists ms)
 >     ,("(select a from t)", SubQueryExpr SqSq ms)
 
@@ -188,7 +188,7 @@ Tests for parsing value expressions
 >          }
 
 > miscOps :: TestItem
-> miscOps = Group "unaryOperators" $ map (uncurry TestValueExpr)
+> miscOps = Group "unaryOperators" $ map (uncurry (TestValueExpr SQL2011))
 >     [("a in (1,2,3)"
 >      ,In True (Iden [Name "a"]) $ InList $ map NumLit ["1","2","3"])
 
@@ -326,7 +326,7 @@ target_string
 >     ]
 
 > aggregates :: TestItem
-> aggregates = Group "aggregates" $ map (uncurry TestValueExpr)
+> aggregates = Group "aggregates" $ map (uncurry (TestValueExpr SQL2011))
 >     [("count(*)",App [Name "count"] [Star])
 
 >     ,("sum(a order by a)"
@@ -341,7 +341,7 @@ target_string
 >     ]
 
 > windowFunctions :: TestItem
-> windowFunctions = Group "windowFunctions" $ map (uncurry TestValueExpr)
+> windowFunctions = Group "windowFunctions" $ map (uncurry (TestValueExpr SQL2011))
 >     [("max(a) over ()", WindowApp [Name "max"] [Iden [Name "a"]] [] [] Nothing)
 >     ,("count(*) over ()", WindowApp [Name "count"] [Star] [] [] Nothing)
 
@@ -400,7 +400,7 @@ target_string
 >     ]
 
 > parens :: TestItem
-> parens = Group "parens" $ map (uncurry TestValueExpr)
+> parens = Group "parens" $ map (uncurry (TestValueExpr SQL2011))
 >     [("(a)", Parens (Iden [Name "a"]))
 >     ,("(a + b)", Parens (BinOp (Iden [Name "a"]) [Name "+"] (Iden [Name "b"])))
 >     ]