Initial commit.

2024-10-05 18:07:31 +03:00 · 2019-06-09 19:36:18 -07:00 · 2019-06-09 19:36:18 -07:00 · 1346ef0ca8
commit 1346ef0ca8
33 changed files with 2391 additions and 0 deletions
--- a/.gitignore
+++ b/.gitignore
@ -0,0 +1,4 @@
+.stack-work/
+dist/
+# Generated automatically by hpack:
+*.cabal
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@ -0,0 +1,28 @@
+# How to Contribute
+
+We'd love to accept your patches and contributions to this project. There are
+just a few small guidelines you need to follow.
+
+## Contributor License Agreement
+
+Contributions to this project must be accompanied by a Contributor License
+Agreement. You (or your employer) retain the copyright to your contribution;
+this simply gives us permission to use and redistribute your contributions as
+part of the project. Head over to <https://cla.developers.google.com/> to see
+your current agreements on file or to sign a new one.
+
+You generally only need to submit a CLA once, so if you've already submitted one
+(even if it was for a different project), you probably don't need to do it
+again.
+
+## Code reviews
+
+All submissions, including submissions by project members, require review. We
+use GitHub pull requests for this purpose. Consult
+[GitHub Help](https://help.github.com/articles/about-pull-requests/) for more
+information on using pull requests.
+
+## Community Guidelines
+
+This project follows
+[Google's Open Source Community Guidelines](https://opensource.google.com/conduct/).
--- a/ChangeLog.md
+++ b/ChangeLog.md
@ -0,0 +1,3 @@
+# Changelog for haskell-syntax
+
+## Unreleased changes
--- a/28
+++ b/28
@ -0,0 +1,28 @@
+Copyright 2019 Google LLC
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+   * Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+   * Redistributions in binary form must reproduce the above
+copyright notice, this list of conditions and the following disclaimer
+in the documentation and/or other materials provided with the
+distribution.
+
+   * Neither the name of Google LLC nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- a/README.md
+++ b/README.md
@ -0,0 +1,70 @@
+# ghc-source-gen
+
+`ghc-source-gen` is a Haskell library for constructing Haskell syntax trees using the GHC API.  This package is compatible with multiple versions of GHC: currently,= 8.2, 8.4, 8.6, and 8.8.
+
+This is not an officially supported Google product.
+
+## Example
+
+This example constructs and prints a module defining the
+`const` function:
+
+```haskell
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+import GHC.SourceGen
+import GHC.Paths (libdir)
+
+constModule :: HsModule'
+constModule =
+    module' (Just "Const") (Just [var "const"]) []
+        [ typeSig "const" $ a --> b --> a
+        , funBind "const" $ matchRhs [wildP, x] x
+        ]
+  where
+    a = var "a"
+    b = var "b"
+    x = var "x"
+
+main = runGhc (Just libdir) $ putPpr constModule
+```
+
+Which will output:
+
+```
+module Const (
+        const
+    ) where
+const :: a -> b -> a
+const _ x = x
+```
+
+## Syntax Types
+
+GHC represents Haskell syntax trees with several parametrized datatypes; for example: `HsExpr p` for expressions, `HsDecl p` for declarations, etc.  The parameter `p` determines which stage of compilation that data has last completed: parsing, renaming, or type-checking.
+
+`ghc-source-gen` constructs values as GHC would represent them
+immediately after the parsing step.  In ghc-8.6, that
+corresponds to `p` being `GhcPs`.  It defines several type
+synonyms, such as:
+
+```haskell
+type HsExpr' = HsExpr GhcPs
+type HsType' = HsType GhcPs
+type HsDecl' = HsDecl GhcPs
+type HsModule' = HsModule GhcPs
+-- etc.
+```
+
+GHC's datatypes generally contain location information in the
+form of [`SrcSpan`](http://hackage.haskell.org/package/ghc/docs/SrcLoc.html#t:SrcSpan) values which point to their original
+location in a source file.  `ghc-source-gen` constructs values
+at runtime, so it uses a dummy value for `SrcSpan` on using a
+dummy SrcSpan.  (GHC does something similar for code written at the interactive GHCi prompt.)
+
+`ghc-source-gen` aims to be a low-level wrapper around GHC's
+types.  In particular, it does not explicitly help the user
+generate unique names like, for example, `template-haskell`'s
+[`newName`](http://hackage.haskell.org/package/template-haskell/docs/Language-Haskell-TH.html#v:newName)
+action.  However, we may add support for that in future
+versions of this library.
--- a/Setup.hs
+++ b/Setup.hs
@ -0,0 +1,8 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+import Distribution.Simple
+main = defaultMain
--- a/check.sh
+++ b/check.sh
@ -0,0 +1,17 @@
+#!/bin/bash
+# Copyright 2019 Google LLC
+#
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file or at
+# https://developers.google.com/open-source/licenses/bsd
+
+# This script tests that ghc-source-gen works on multiple GHC versions.
+# TODO: turn this into a CI script.
+
+set -ueo pipefail
+
+for flag in --resolver={lts-11.22,lts-12.8,lts-13.23} --stack-yaml=stack-8.8.yaml
+do
+    echo ====== $flag ======
+    stack test $flag ghc-source-gen
+done
--- a/ghc-show-ast/Main.hs
+++ b/ghc-show-ast/Main.hs
@ -0,0 +1,98 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE GADTs #-}
+module Main where
+
+import Data.Data
+import Data.Typeable (cast)
+import Language.Haskell.GHC.ExactPrint.Parsers
+import System.Environment (getArgs)
+import Text.PrettyPrint
+
+import FastString
+import Name
+    ( Name
+    , isExternalName
+    , isInternalName
+    , isSystemName
+    , isWiredInName
+    , nameOccName
+    , nameUnique
+    )
+import OccName
+    ( OccName
+    , occNameSpace
+    , occNameString
+    , NameSpace
+    , varName
+    , dataName
+    , tvName
+    , tcClsName
+    )
+
+main :: IO ()
+main = do
+    [f] <- getArgs
+    result <- parseModule f
+    case result of
+        Left err -> print err
+        Right (_, ps) -> do
+            print $ gPrint ps
+
+gPrint :: Data a => a -> Doc
+gPrint x
+    | showConstr c == "L", [_,e] <- xs = e
+    | showConstr c == "(:)" = gPrintList x
+    | Just occ <- cast x = text $ showOccName occ
+    | Just name <- cast x = text $ showName name
+    | Just s <- cast x = text $ showFastString s
+    | otherwise =
+        hang (text $ showConstr c) 2 (sep $ map parens xs)
+  where
+    c = toConstr x
+    xs = gmapQ gPrint x
+
+gPrintList :: Data a => a -> Doc
+gPrintList = brackets . sep . punctuate comma . elems
+  where
+    elems :: Data b => b -> [Doc]
+    elems xs = case gmapQ SomeData xs of
+                [] -> []
+                [x,y] -> renderCons x y
+                _ -> error $ "gPrintList: unexpected number of fields"
+    renderCons :: SomeData -> SomeData -> [Doc]
+    renderCons (SomeData x) (SomeData y) = gPrint x : elems y
+
+data SomeData where
+    SomeData :: Data a => a -> SomeData
+
+showOccName :: OccName -> String
+showOccName o = "OccName{" ++ showNameSpace (occNameSpace o)
+                ++ "," ++ show (occNameString o) ++ "}"
+
+showFastString :: FastString -> String
+showFastString = show . unpackFS
+
+showNameSpace :: NameSpace -> String
+showNameSpace ns
+    | ns == varName = "VarName"
+    | ns == dataName = "DataName"
+    | ns == tvName = "TvName"
+    | ns == tcClsName = "TcClsName"
+    | otherwise = "Unknown"
+
+showName :: Name -> String
+showName n = "Name{" ++ nameSort ++ ":" ++ showOccName (nameOccName n)
+                ++ "," ++ show (nameUnique n)
+                ++ "}"
+  where
+    nameSort
+        | isExternalName n = "external"
+        | isInternalName n = "internal"
+        | isSystemName n = "system"
+        | isWiredInName n = "wired-in"
+        | otherwise = "unknown" -- Shouldn't happen; these guards are exhaustive
--- a/ghc-show-ast/README.md
+++ b/ghc-show-ast/README.md
@ -0,0 +1,6 @@
+ghc-show-ast helps debug the behavior of GHC that ghc-source-gen is trying to imitate.
+This program parses a source file with GHC and then pretty-prints the AST.
+
+To use:
+
+    stack run ghc-show-ast -- path/to/file.hs
--- a/ghc-show-ast/package.yaml
+++ b/ghc-show-ast/package.yaml
@ -0,0 +1,16 @@
+# Copyright 2019 Google LLC
+#
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file or at
+# https://developers.google.com/open-source/licenses/bsd
+
+name: ghc-show-ast
+
+executables:
+  ghc-show-ast:
+    main: Main.hs
+    dependencies:
+    - base
+    - ghc
+    - ghc-exactprint
+    - pretty
--- a/package.yaml
+++ b/package.yaml
@ -0,0 +1,58 @@
+# Copyright 2019 Google LLC
+#
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file or at
+# https://developers.google.com/open-source/licenses/bsd
+
+name:                ghc-source-gen
+version:             0.1.0.0
+github:              "google/ghc-source-gen"
+license:             BSD3
+author:              "Judah Jacobson"
+maintainer:          "judahjacobson@google.com"
+copyright:           "Google LLC"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+synopsis:            Constructs Haskell syntax trees for the GHC API.
+category:            Development
+description:         Please see the README on GitHub at <https://github.com/google/ghc-source-gen>
+
+dependencies:
+- base >= 4.7 && < 5
+- ghc >= 8.2 && < 8.9
+
+default-extensions:
+- DataKinds
+- FlexibleInstances
+- TypeSynonymInstances
+
+library:
+  source-dirs: src
+  other-modules:
+  - GHC.SourceGen.Binds.Internal
+  - GHC.SourceGen.Expr.Internal
+  - GHC.SourceGen.Lit.Internal
+  - GHC.SourceGen.Name.Internal
+  - GHC.SourceGen.Syntax.Internal
+  - GHC.SourceGen.Type.Internal
+
+tests:
+  pprint_examples:
+    main: pprint_examples.hs
+    source-dirs: tests
+    dependencies:
+    - ghc-source-gen
+    - ghc-paths == 0.1.*
+
+  # TODO: Fill out this test, and use it to replace pprint_examples.
+  pprint_test:
+    main: pprint_test.hs
+    source-dirs: tests
+    dependencies:
+    - ghc-source-gen
+    - ghc-paths == 0.1.*
+    - tasty
+    - tasty-hunit
--- a/src/GHC/SourceGen.hs
+++ b/src/GHC/SourceGen.hs
@ -0,0 +1,45 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module exports all of the definitions in this package in one
+-- convenient location.
+--
+-- For more details and examples of usage, see
+-- <https://github.com/google/ghc-source-gen>.
+module GHC.SourceGen
+    ( -- * Syntax types
+      -- | These modules declare combinators for constructing different parts
+      -- of a GHC syntax tree.
+      module GHC.SourceGen.Syntax,
+      module GHC.SourceGen.Name,
+      module GHC.SourceGen.Decl,
+      module GHC.SourceGen.Expr,
+      module GHC.SourceGen.Module,
+      module GHC.SourceGen.Pat,
+      module GHC.SourceGen.Type,
+      -- * Overloaded combinators
+      -- | Certain concepts make sense in different
+      -- parts of Haskell syntax.  For example, 'var' may be used in
+      -- expressions, types, patterns, and import or export lists.
+      module GHC.SourceGen.Binds,
+      module GHC.SourceGen.Lit,
+      module GHC.SourceGen.Overloaded,
+      -- * Renders Haskell syntax into text
+      module GHC.SourceGen.Pretty,
+    ) where
+
+import GHC.SourceGen.Binds
+import GHC.SourceGen.Decl
+import GHC.SourceGen.Expr
+import GHC.SourceGen.Lit
+import GHC.SourceGen.Module
+import GHC.SourceGen.Name
+import GHC.SourceGen.Overloaded
+import GHC.SourceGen.Pat
+import GHC.SourceGen.Pretty
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Type
+
--- a/src/GHC/SourceGen/Binds.hs
+++ b/src/GHC/SourceGen/Binds.hs
@ -0,0 +1,189 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module provides combinators for constructing Haskell declarations.
+module GHC.SourceGen.Binds
+    ( -- * Overloaded constructors
+      HasValBind(..)
+    , typeSig
+    , typeSigs
+    , funBind
+    , funBinds
+    -- * RawMatch
+    -- $rawMatch
+    , RawMatch
+    , match
+    , matchRhs
+    -- ** RawGRHS
+    , RawGRHS
+    , rhs
+    , guardedStmt
+    , guarded
+    -- ** Statements
+    , stmt
+    , (<--)
+    -- ** Where clauses
+    , where'
+    , RawValBind
+    ) where
+
+import BasicTypes (LexicalFixity(..))
+import HsBinds
+import HsExpr
+import HsDecls
+import HsTypes
+import TcEvidence (HsWrapper(WpHole))
+
+import GHC.SourceGen.Binds.Internal
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Type.Internal (sigWcType)
+
+-- | Declare that a multiple functions or values have a type:
+--
+-- > f, g :: A
+-- > =====
+-- > typeSigs ["f", "g"] (var "A")
+typeSigs :: HasValBind t => [RawRdrName] -> HsType' -> t
+typeSigs names t =
+    sigB $ noExt TypeSig (map typeRdrName names)
+        $ sigWcType t
+
+-- | Declare that a function or value has a type:
+--
+-- > f :: A
+-- > =====
+-- > typeSig "f" (var "A")
+typeSig :: HasValBind t => RawRdrName -> HsType' -> t
+typeSig n = typeSigs [n]
+
+-- | Define a function or value.
+--
+-- > f = x
+-- > =====
+-- > funBinds "f" [matchRhs [] "x"]
+--
+-- > id x = x
+-- > =====
+-- > funBinds "id" [matchRhs [var "x"] (var "x")]
+--
+-- > not True = False
+-- > not False = True
+-- > =====
+-- > funBinds "not"
+-- >   [ matchRhs [var "True"] (var "False")
+-- >   , matchRhs [var "False"] (var "True")
+-- >   ]
+funBinds :: HasValBind t => RawRdrName -> [RawMatch] -> t
+funBinds name matches = bindB $ withPlaceHolder
+        (noExt FunBind name'
+            (matchGroup context matches) WpHole)
+        []
+  where
+    name' = valueRdrName name
+    context = FunRhs name' Prefix NoSrcStrict
+
+-- | Define a function that has a single case.
+--
+-- > f = x
+-- > =====
+-- > funBind "f" (matchRhs [] "x")
+--
+-- > id x = x
+-- > =====
+-- > funBind "id" $ matchRhs [var "x"] (var "x")
+--
+funBind :: HasValBind t => RawRdrName -> RawMatch -> t
+funBind name m = funBinds name [m]
+
+{- $rawMatch
+
+A function definition is made up of one or more 'RawMatch' terms.  Each
+'RawMatch' corresponds to a single pattern match.  For example, to define the
+"not" function:
+
+> not True = False
+> not False = True
+
+We could using a list of two 'RawMatch'es:
+
+> funBinds "not"
+>   [ matchRhs [var "True"] (var "False")
+>   , matchRhs [var "False"] (var "True")
+>   ]
+
+A match may consist of one or more guarded expressions.  For example, to
+define the function as:
+
+> not x
+>   | x = False
+>   | otherwise = True
+
+We would say:
+
+> funBinds "not"
+>   [ var "x" ==> match
+>       [ guardedStmt (var "x") (rhs (var "False"))
+>       , guardedStmt (var "otherwise") (rhs (var "True"))
+>       ]
+>   ]
+-}
+
+-- | Construct a function match consisting of multiple guards.
+match :: [Pat'] -> [RawGRHS] -> RawMatch
+match ps grhss = RawMatch ps grhss mempty
+
+-- | Construct a function match with a single case.
+matchRhs :: [Pat'] -> HsExpr' -> RawMatch
+matchRhs ps e = match ps [rhs e]
+
+where' :: RawMatch -> [RawValBind] -> RawMatch
+where' r vbs = r { rawWhere = rawWhere r ++ vbs }
+
+rhs :: HsExpr' -> RawGRHS
+rhs = RawGRHS []
+
+guarded :: [Stmt'] -> RawGRHS -> RawGRHS
+guarded ss (RawGRHS ss' e) = RawGRHS (ss ++ ss') e
+
+guardedStmt :: HsExpr' -> RawGRHS -> RawGRHS
+guardedStmt e = guarded [stmt e]
+
+-- | An expression statement.  May be used in a do expression (with 'do'') or in a
+-- match (with 'guarded').
+--
+-- TODO: also allow using statements in list comprehensions.
+stmt :: HsExpr' -> Stmt'
+-- For now, don't worry about rebindable syntax.
+stmt e =
+    withPlaceHolder $ noExt BodyStmt (builtLoc e) noSyntaxExpr noSyntaxExpr
+
+-- | A statement that binds a pattern.
+--
+-- > x <- act
+-- > =====
+-- > var "x" <-- var "act"
+(<--) :: Pat' -> HsExpr' -> Stmt'
+p <-- e = withPlaceHolder $ noExt BindStmt (builtPat p) (builtLoc e) noSyntaxExpr noSyntaxExpr
+infixl 1 <--
+
+-- | Syntax types which can declare/define functions.  For example:
+-- declarations, or the body of a class declaration or class instance.
+--
+-- Use 'typeSig' or 'typeSigs' to declare that functions or values have
+-- types, and use 'funBind' to give them definitions.
+class HasValBind t where
+    sigB :: Sig' -> t
+    bindB :: HsBind' -> t
+
+instance HasValBind RawValBind where
+    sigB = SigV
+    bindB = BindV
+
+instance HasValBind HsDecl' where
+    sigB = noExt SigD
+    bindB = noExt ValD
--- a/src/GHC/SourceGen/Binds/Internal.hs
+++ b/src/GHC/SourceGen/Binds/Internal.hs
@ -0,0 +1,87 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+module GHC.SourceGen.Binds.Internal where
+
+import BasicTypes (Origin(Generated))
+import Bag (listToBag)
+import HsBinds
+import HsExpr (MatchGroup(..), Match(..), GRHS(..), GRHSs(..))
+import SrcLoc (Located)
+
+#if !MIN_VERSION_ghc(8,6,0)
+import PlaceHolder (PlaceHolder(..))
+#endif
+
+
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+
+data RawValBind
+    = SigV Sig'
+    | BindV HsBind'
+
+valBinds :: [RawValBind] -> HsLocalBinds'
+-- This case prevents GHC from printing an empty "where" clause:
+valBinds [] = noExt EmptyLocalBinds
+valBinds vbs =
+    noExt HsValBinds
+#if MIN_VERSION_ghc(8,6,0)
+        $ noExt ValBinds
+#else
+        $ noExt ValBindsIn
+#endif
+            (listToBag $ map builtLoc binds)
+            (map builtLoc sigs)
+  where
+    sigs = [s | SigV s <- vbs]
+    binds = [b | BindV b <- vbs]
+
+-- | A single function pattern match, including an optional "where" clause.
+--
+-- For example:
+--
+-- > f x
+-- >    | cond = y
+-- >    | otherwise = z
+-- >  where
+-- >    y = ...
+-- >    z = ...
+data RawMatch = RawMatch
+    { rawMatchPats :: [Pat']
+    , rawGRHSs :: [RawGRHS]
+    , rawWhere :: [RawValBind]
+    }
+
+
+matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' (Located HsExpr')
+matchGroup context matches =
+    noExt MG (builtLoc $ map (builtLoc . mkMatch) matches)
+#if !MIN_VERSION_ghc(8,6,0)
+                            [] PlaceHolder
+#endif
+                            Generated
+  where
+    mkMatch :: RawMatch -> Match' (Located HsExpr')
+    mkMatch r = noExt Match context (map builtPat $ rawMatchPats r)
+#if !MIN_VERSION_ghc(8,4,0)
+                    -- The GHC docs say: "A type signature for the result of the match."
+                    -- The parsing step produces 'Nothing' for this field.
+                    Nothing
+#endif
+                    $ noExt GRHSs (map (builtLoc . mkGRHS) $ rawGRHSs r)
+                            (builtLoc $ valBinds $ rawWhere r)
+
+-- | The "right-hand-side" of a function definition.  For example:
+--
+-- > f x | y = z
+data RawGRHS = RawGRHS [Stmt'] HsExpr'
+
+mkGRHS :: RawGRHS -> GRHS' (Located HsExpr')
+mkGRHS (RawGRHS stmts e) = noExt GRHS (map builtLoc stmts) (builtLoc e)
+
+
--- a/src/GHC/SourceGen/Decl.hs
+++ b/src/GHC/SourceGen/Decl.hs
@ -0,0 +1,307 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+-- | This module provides combinators for constructing Haskell declarations.
+module GHC.SourceGen.Decl
+    ( -- * Type declarations
+      type'
+    , newtype'
+    , data'
+      -- * Data constructors
+    , prefixCon
+    , infixCon
+    , recordCon
+    , Field
+    , field
+    , strict
+    , lazy
+      -- * Class declarations
+    , class'
+    , ClassDecl
+    , funDep
+      -- * Instance declarations
+    , instance'
+    , RawInstDecl
+    ) where
+
+import BasicTypes (LexicalFixity(Prefix))
+import Bag (listToBag)
+import HsDecls
+import HsTypes
+    ( ConDeclField(..)
+    , FieldOcc(..)
+    , HsConDetails(..)
+    , HsSrcBang(..)
+    , HsType(..)
+    , SrcStrictness(..)
+    , SrcUnpackedness(..)
+    )
+import SrcLoc (Located)
+
+#if MIN_VERSION_ghc(8,6,0)
+import HsExtension (NoExt(NoExt))
+#else
+import PlaceHolder (PlaceHolder(..))
+#endif
+
+import GHC.SourceGen.Binds
+import GHC.SourceGen.Lit.Internal (noSourceText)
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Type.Internal
+
+-- | A definition that can appear in the body of a @class@ declaration.
+data ClassDecl
+    = ClassSig Sig'
+    | ClassDefaultMethod HsBind'
+    | ClassFunDep [RawRdrName] [RawRdrName]
+    -- TODO: type families
+
+instance HasValBind ClassDecl where
+    sigB = ClassSig
+    bindB = ClassDefaultMethod
+
+-- | A functional dependency for a class.
+--
+-- > | a, b -> c
+-- > =====
+-- > funDep ["a", "b"] ["c"]
+--
+-- > class Ident a b | a -> b, b -> a where
+-- >   ident :: a -> b
+-- > =====
+-- > class' [] "Ident" ["a", "b"]
+-- >    [ funDep ["a"] ["b"]
+-- >    , funDep ["b"] ["a"]
+-- >    , typeSig "ident" $ var "a" --> var "b"
+-- >    ]
+funDep :: [RawRdrName] -> [RawRdrName] -> ClassDecl
+funDep = ClassFunDep
+
+-- TODO:
+-- - kinded variables
+-- - fixity of declaration
+-- - functional dependencies
+-- - associated types
+
+-- | A class declaration.
+--
+-- > class (Real a, Enum a) => Integral a where
+-- >   divMod :: a -> a -> (a, a)
+-- >   div :: a -> a -> a
+-- >   div x y = fst (divMod x y)
+-- > =====
+-- > let a = var "a"
+-- > in class'
+-- >      [var "Real" @@ a, var "Enum" @@ a]
+-- >      "Integral"
+-- >      ["a"]
+-- >      [ typeSig "divMod" $ a --> a --> tuple [a, a]
+-- >      , typeSig "div" $ a --> a --> a
+-- >      , funBind "div"
+-- >          $ matchRhs [var "x", var "y"]
+-- >             $ var "fst" @@ (var "divMod" @@ var "x" @@ var "y")
+-- >      ]
+class'
+    :: [HsType'] -- ^ Context
+    -> RawRdrName -- ^ Class name
+    -> [RawRdrName] -- ^ Type parameters
+    -> [ClassDecl] -- ^ Class declarations
+    -> HsDecl'
+class' context name vars decls
+    = noExt TyClD $ ClassDecl
+            { tcdCtxt = builtLoc $ map builtLoc context
+#if MIN_VERSION_ghc(8,6,0)
+            , tcdCExt = NoExt
+#else
+            , tcdFVs = PlaceHolder
+#endif
+            , tcdLName = typeRdrName name
+            , tcdTyVars = mkQTyVars vars
+            , tcdFixity = Prefix
+            , tcdFDs = [ builtLoc (map typeRdrName xs, map typeRdrName ys)
+                       | ClassFunDep xs ys <- decls
+                       ]
+            , tcdSigs = [builtLoc sig | ClassSig sig <- decls]
+            , tcdMeths =
+                listToBag [builtLoc bind | ClassDefaultMethod bind <- decls]
+            , tcdATs = []  -- Associated types
+            , tcdATDefs = []  -- Associated type defaults
+            , tcdDocs = []  -- Haddocks
+            }
+
+-- | A definition that can appear in the body of an @instance@ declaration.
+data RawInstDecl
+    = InstSig Sig'
+    | InstBind HsBind'
+
+instance HasValBind RawInstDecl where
+    sigB = InstSig
+    bindB = InstBind
+
+-- | An instance declaration.
+--
+-- > instance Show Bool where
+-- >   show :: Bool -> String -- Requires the InstanceSigs extension
+-- >   show True = "True"
+-- >   show False = "False"
+-- > =====
+-- > instance' (var "Show" @@ var "Bool")
+-- >   [ typeSig "show" $ var "Bool" --> var "String"
+-- >   , funBinds "show"
+-- >       [ matchRhs [var "True"] $ string "True"
+-- >       , matchRhs [var "False"] $ string "False"
+-- >       ]
+-- >   ]
+instance' :: HsType' -> [RawInstDecl] -> HsDecl'
+instance' ty decls = noExt InstD  $ noExt ClsInstD $ ClsInstDecl
+    { cid_poly_ty = sigType ty
+#if MIN_VERSION_ghc(8,6,0)
+    , cid_ext = NoExt
+#endif
+    , cid_binds = listToBag [builtLoc b | InstBind b <- decls]
+    , cid_sigs = [builtLoc sig | InstSig sig <- decls]
+    , cid_tyfam_insts = []
+    , cid_datafam_insts = []
+    , cid_overlap_mode = Nothing
+    }
+
+-- | Declares a type synonym.
+--
+-- > type A a b = B b a
+-- > =====
+-- > type' "A" ["a", "b"] $ var "B" @@ var "b" @@ var "a"
+type' :: RawRdrName -> [RawRdrName] -> HsType' -> HsDecl'
+type' name vars t =
+    noExt TyClD $ withPlaceHolder $ noExt SynDecl (typeRdrName name)
+        (mkQTyVars vars)
+        Prefix
+        (builtLoc t)
+
+newOrDataType ::
+    NewOrData -> RawRdrName -> [RawRdrName] -> [ConDecl'] -> HsDecl'
+newOrDataType newOrData name vars conDecls
+    = noExt TyClD $ withPlaceHolder $ withPlaceHolder $
+        noExt DataDecl (typeRdrName name)
+            (mkQTyVars vars)
+            Prefix
+            $ noExt HsDataDefn newOrData
+                (builtLoc []) Nothing
+                Nothing
+                (map builtLoc conDecls)
+                (builtLoc [])
+
+-- | A newtype declaration.
+--
+-- > newtype Const a b = Const a
+-- > =====
+-- > newtype' "Const" ["a", "b"] $ conDecl "Const" [var "a"]
+newtype' :: RawRdrName -> [RawRdrName] -> ConDecl' -> HsDecl'
+newtype' name vars conD = newOrDataType NewType name vars [conD]
+
+-- | A data declaration.
+--
+-- > data Either a b = Left a | Right b
+-- > =====
+-- > data' "Either" ["a", "b"]
+-- >   [ conDecl "Left" [var "a"]
+-- >   , conDecl "Right" [var "b"]
+-- >   ]
+data' :: RawRdrName -> [RawRdrName] -> [ConDecl'] -> HsDecl'
+data' = newOrDataType DataType
+
+-- | Declares a Haskell-98-style prefix constructor for a data or type
+-- declaration.
+--
+-- > Foo a Int
+-- > =====
+-- > conDecl "Foo" [field (var "a"), field (var "Int")]
+prefixCon :: RawRdrName -> [Field] -> ConDecl'
+prefixCon name fields = renderCon98Decl name
+    $ PrefixCon $ map renderField fields
+
+-- | Declares a Haskell-98-style infix constructor for a data or type
+-- declaration.
+--
+-- > A b :+: C d
+-- > =====
+-- > infixCon (field (var "A" @@ var "b")) ":+:" (field (Var "C" @@ var "d"))
+infixCon :: Field -> RawRdrName -> Field -> ConDecl'
+infixCon f name f' = renderCon98Decl name
+    $ InfixCon (renderField f) (renderField f')
+
+-- | Declares Haskell-98-style record constructor for a data or type
+-- declaration.
+--
+-- > A { x :: B, y :: C }
+-- > =====
+-- > recordCon "A" [("x", var "B"), ("y", var "C")]
+recordCon :: RawRdrName -> [(RawRdrName, Field)] -> ConDecl'
+recordCon name fields = renderCon98Decl name
+    $ RecCon $ builtLoc $ map mkLConDeclField fields
+  where
+    mkLConDeclField (n, f) =
+        builtLoc $ noExt ConDeclField
+                        [builtLoc $ withPlaceHolder $ noExt FieldOcc $ valueRdrName n]
+                        (renderField f)
+                        Nothing
+
+-- | An individual argument of a data constructor.  Contains a type for the field,
+-- and whether the field is strict or lazy.
+data Field = Field
+    { fieldType :: HsType'
+    , strictness :: SrcStrictness
+    }
+
+-- | A field with no explicit strictness annotations.
+--
+-- > A b
+-- > =====
+-- > field $ var "A" @@ var "b"
+field :: HsType' -> Field
+field t = Field t NoSrcStrict
+
+-- | Give a field an explicit strictness annotation.  Overrides any such previous
+-- annotations (for example, from 'lazy').
+--
+-- > !(A b)
+-- > =====
+-- > strict $ field $ var "A" @@ var "b"
+strict :: Field -> Field
+strict f = f { strictness = SrcStrict }
+
+-- | Give a field an explicit laziness annotation.  This feature is useful in combination
+-- with the @StrictData@ extension.  Overrides any such previous
+-- annotations (for example, from 'strict').
+--
+-- > !(A b)
+-- > =====
+-- > strict $ field $ var "A" @@ var "b"
+lazy :: Field -> Field
+lazy f = f { strictness = SrcLazy }
+
+renderField :: Field -> Located HsType'
+-- TODO: parenthesizeTypeForApp is an overestimate in the case of
+-- rendering an infix or record type.
+renderField f = wrap $ parenthesizeTypeForApp $ builtLoc $ fieldType f
+  where
+    wrap = case strictness f of
+        NoSrcStrict -> id
+        s -> builtLoc . (noExt HsBangTy $ noSourceText HsSrcBang NoSrcUnpack s)
+
+renderCon98Decl :: RawRdrName -> HsConDeclDetails' -> ConDecl'
+renderCon98Decl name details = noExt ConDeclH98 (typeRdrName name)
+#if MIN_VERSION_ghc(8,6,0)
+    (builtLoc False)
+    []
+#else
+    Nothing
+#endif
+    Nothing
+    details
+    Nothing
--- a/src/GHC/SourceGen/Expr.hs
+++ b/src/GHC/SourceGen/Expr.hs
@ -0,0 +1,104 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+-- | This module provides combinators for constructing Haskell expressions.
+module GHC.SourceGen.Expr where
+
+import HsExpr
+import Data.String (fromString)
+import SrcLoc (unLoc)
+
+import GHC.SourceGen.Binds.Internal
+import GHC.SourceGen.Binds
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Type.Internal
+    ( parenthesizeTypeForApp
+    , sigWcType
+    , wcType
+    )
+
+-- | An overloaded label, as used with the @OverloadedLabels@ extension.
+--
+-- > #foo
+-- > =====
+-- > overLabel "foo"
+overLabel :: String -> HsExpr'
+overLabel = noExt HsOverLabel Nothing . fromString
+
+let' :: [RawValBind] -> HsExpr' -> HsExpr'
+let' binds e = noExt HsLet (builtLoc $ valBinds binds) $ builtLoc e
+
+case' :: HsExpr' -> [RawMatch] -> HsExpr'
+case' e matches = noExt HsCase (builtLoc e)
+                    $ matchGroup CaseAlt matches
+
+lambda :: [Pat'] -> HsExpr' -> HsExpr'
+lambda ps e = noExt HsLam $ matchGroup LambdaExpr [matchRhs ps e]
+
+lambdaCase :: [RawMatch] -> HsExpr'
+lambdaCase = noExt HsLamCase . matchGroup CaseAlt
+
+if' :: HsExpr' -> HsExpr' -> HsExpr' -> HsExpr'
+if' x y z = noExt HsIf Nothing (builtLoc x) (builtLoc y) (builtLoc z)
+
+-- | A MultiWayIf expression.
+--
+-- > if | f x = "f"
+-- >    | g x = "g"
+-- >    | otherwise = "h"
+-- > =====
+-- > multiIf
+-- >     [ guardedStmt (var "f" @@ var "x") $ rhs (string "f")
+-- >     , guardedStmt (var "g" @@ var "x") $ rhs (string "g")
+-- >     , guardedStmt (var "otherwise") $ rhs (string "h")
+-- >     ]
+multiIf :: [RawGRHS] -> HsExpr'
+multiIf = noExtOrPlaceHolder HsMultiIf . map (builtLoc . mkGRHS)
+
+-- | A do-expression.
+--
+-- Individual statements may be constructed with '<--' and/or 'stmt'.
+--
+-- > do
+-- >   x <- act
+-- >   return x
+-- > =====
+-- > do' [var "x" <-- var "act", stmt $ var "return" @@ var "x"]
+do' :: [Stmt'] -> HsExpr'
+do' = withPlaceHolder . noExt HsDo DoExpr . builtLoc . map builtLoc
+
+-- | A type constraint on an expression.
+--
+-- > e :: t
+-- > =====
+-- > var "e" @::@ var "t"
+(@::@) :: HsExpr' -> HsType' -> HsExpr'
+#if MIN_VERSION_ghc(8,8,0)
+e @::@ t = noExt ExprWithTySig (builtLoc e) (sigWcType t)
+#elif MIN_VERSION_ghc(8,6,0)
+e @::@ t = ExprWithTySig (sigWcType t) (builtLoc e)
+#else
+e @::@ t = ExprWithTySig (builtLoc e) (sigWcType t)
+#endif
+-- TODO: The Outputable instance prepends extra spaces; I'm not sure why.
+
+-- | Explicit type application.
+--
+-- > f @ Int
+-- > =====
+-- > var "f" @@ var "Int"
+tyApp :: HsExpr' -> HsType' -> HsExpr'
+#if MIN_VERSION_ghc(8,8,0)
+tyApp e t = noExt HsAppType (builtLoc e) t'
+#elif MIN_VERSION_ghc(8,6,0)
+tyApp e t = HsAppType t' (builtLoc e)
+#else
+tyApp e t = HsAppType (builtLoc e) t'
+#endif
+  where
+    t' = wcType $ unLoc $ parenthesizeTypeForApp $ builtLoc t
--- a/src/GHC/SourceGen/Expr/Internal.hs
+++ b/src/GHC/SourceGen/Expr/Internal.hs
@ -0,0 +1,75 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+module GHC.SourceGen.Expr.Internal where
+
+#if MIN_VERSION_ghc(8,4,0)
+import BasicTypes (IntegralLit(..))
+#endif
+import HsExpr
+import HsLit
+import SrcLoc (Located, unLoc)
+
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+
+parenthesizeExprForApp, parenthesizeExprForOp
+    :: Located HsExpr' -> Located HsExpr'
+parenthesizeExprForApp e 
+    | needsExprForApp (unLoc e) = parExpr e
+    | otherwise = e
+parenthesizeExprForOp e
+    | needsExprForOp (unLoc e) = parExpr e
+    | otherwise = e
+
+parExpr :: Located HsExpr' -> Located HsExpr'
+parExpr = builtLoc . noExt HsPar
+
+#if MIN_VERSION_ghc(8,6,0)
+#define WILD_EXT _
+#else
+#define WILD_EXT
+#endif
+
+needsExprForApp, needsExprForOp :: HsExpr' -> Bool
+needsExprForOp e = case e of
+    -- TODO: more care for literals; only needed for negative numbers?
+    HsLit WILD_EXT l -> litNeedsParen l
+    HsOverLit WILD_EXT l -> overLitNeedsParen l
+    HsLam{} -> True
+    HsLamCase{} -> True
+    OpApp{} -> True
+    NegApp{} -> True
+    HsCase{} -> True
+    HsIf{} -> True
+    HsMultiIf{} -> True
+    HsLet{} -> True
+    HsDo{} -> True
+    ExprWithTySig{} -> True
+    _ -> False
+needsExprForApp e = case e of
+    HsApp{} -> True
+    HsStatic{} -> True
+    _ -> needsExprForOp e
+
+litNeedsParen :: HsLit' -> Bool
+-- For now, ignoring cases that only arrive from internal compiler passes.
+-- Furthermore, GHC parses primitive numbers like -3.0# without needing parentheses.
+-- So we can uniformly ignore this step.
+litNeedsParen _ = False
+
+overLitNeedsParen :: HsOverLit' -> Bool
+overLitNeedsParen = needs . ol_val
+  where
+#if MIN_VERSION_ghc(8,4,0)
+    needs (HsIntegral x) = il_neg x
+#else
+    needs (HsIntegral _ x) = x < 0
+#endif
+    -- GHC shows fractional values with "%", so wrap them unconditionally.
+    needs HsFractional{} = True
+    needs _ = False
--- a/src/GHC/SourceGen/Lit.hs
+++ b/src/GHC/SourceGen/Lit.hs
@ -0,0 +1,62 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+-- | This module provides combinators for constructing Haskell literals,
+-- which may be used in either patterns or expressions.
+module GHC.SourceGen.Lit where
+
+import BasicTypes (FractionalLit(..))
+#if MIN_VERSION_ghc(8,4,0)
+import BasicTypes(IntegralLit(..))
+#endif
+import HsLit
+import HsExpr (noExpr, noSyntaxExpr, HsExpr(..))
+import HsPat (Pat(..))
+import FastString (fsLit)
+
+import GHC.SourceGen.Lit.Internal
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+
+class HasLit e where
+    lit :: HsLit' -> e
+    overLit :: HsOverLit' -> e
+
+instance HasLit HsExpr' where
+    lit = noExt HsLit
+    overLit = noExt HsOverLit
+
+instance HasLit Pat' where
+    lit = noExt LitPat
+    overLit l = withPlaceHolder
+                    $ noExt NPat (builtLoc l) Nothing noSyntaxExpr
+
+char :: HasLit e => Char -> e
+char = lit . noSourceText HsChar
+
+string :: HasLit e => String -> e
+string = lit . noSourceText HsString . fsLit
+
+-- | Note: this is an *overloaded* integer.
+int :: HasLit e => Integer -> e
+int n = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit il) noExpr
+  where
+#if MIN_VERSION_ghc(8,4,0)
+    il = HsIntegral $ noSourceText IL (n < 0) n
+#else
+    il = noSourceText HsIntegral n
+#endif
+
+-- | Note: this is an *overloaded* rational, e.g., a decimal number.
+frac :: HasLit e => Rational -> e
+frac x = overLit $ withPlaceHolder $ withPlaceHolder (noExt OverLit $ HsFractional il) noExpr
+  where
+#if MIN_VERSION_ghc(8,4,0)
+    il = noSourceText FL (x < 0) x
+#else
+    il = FL (show x) x
+#endif
--- a/src/GHC/SourceGen/Lit/Internal.hs
+++ b/src/GHC/SourceGen/Lit/Internal.hs
@ -0,0 +1,12 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+module GHC.SourceGen.Lit.Internal where
+
+import BasicTypes (SourceText(NoSourceText))
+
+noSourceText :: (SourceText -> a) -> a
+noSourceText = ($ NoSourceText)
--- a/src/GHC/SourceGen/Module.hs
+++ b/src/GHC/SourceGen/Module.hs
@ -0,0 +1,53 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module provides combinators for constructing Haskell modules,
+-- including import and export statements.
+module GHC.SourceGen.Module where
+
+import HsSyn
+    ( HsModule(..)
+    , ImportDecl(..)
+    )
+
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Lit.Internal (noSourceText)
+
+module'
+    :: Maybe ModuleNameStr
+    -> Maybe [IE'] -- ^ Exports
+    -> [ImportDecl']
+    -> [HsDecl']
+    -> HsModule'
+module' name exports imports decls = HsModule
+    { hsmodName = fmap (builtLoc . unModuleNameStr) name
+    , hsmodExports = fmap (builtLoc . map builtLoc) exports
+    , hsmodImports = map builtLoc imports
+    , hsmodDecls = fmap builtLoc decls
+    , hsmodDeprecMessage = Nothing
+    , hsmodHaddockModHeader = Nothing
+    }
+
+qualified' :: ImportDecl' -> ImportDecl'
+qualified' d = d { ideclQualified = True }
+
+as' :: ImportDecl' -> ModuleNameStr -> ImportDecl'
+as' d m = d { ideclAs = Just (builtLoc $ unModuleNameStr m) }
+
+import' :: ModuleNameStr -> ImportDecl'
+import' m = noSourceText (noExt ImportDecl)
+            (builtLoc $ unModuleNameStr m)
+            Nothing False False False False Nothing Nothing
+
+exposing :: ImportDecl' -> [IE'] -> ImportDecl'
+exposing d ies = d
+    { ideclHiding = Just (False, builtLoc $ map builtLoc ies) }
+
+hiding :: ImportDecl' -> [IE'] -> ImportDecl'
+hiding d ies = d
+    { ideclHiding = Just (True, builtLoc $ map builtLoc ies) }
--- a/src/GHC/SourceGen/Name.hs
+++ b/src/GHC/SourceGen/Name.hs
@ -0,0 +1,26 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module defines custom types for defining names of various
+-- syntax terms.
+--
+-- These types are all instances of 'Data.String.IsString'.  For easier use,
+-- we recommend enabling the @OverloadedStrings@ extension.
+module GHC.SourceGen.Name
+    ( RawRdrName(..)
+    , RawOccName
+    , ModuleNameStr(..)
+    , qual
+    , unqual
+    ) where
+
+import GHC.SourceGen.Name.Internal
+
+unqual :: RawOccName -> RawRdrName
+unqual = RawUnqual
+
+qual :: ModuleNameStr -> RawOccName -> RawRdrName
+qual = RawQual
--- a/src/GHC/SourceGen/Name/Internal.hs
+++ b/src/GHC/SourceGen/Name/Internal.hs
@ -0,0 +1,72 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+module GHC.SourceGen.Name.Internal where
+
+import Data.Char (isUpper)
+import Data.String (IsString(..))
+import FastString (FastString, fsLit)
+import Module (mkModuleNameFS, ModuleName)
+import RdrName
+import OccName
+import SrcLoc (Located)
+
+import GHC.SourceGen.Syntax.Internal (builtLoc)
+
+-- | A string identifier.  This definition is simililar to 'RdrName', but
+-- independent of whether it's in the type or value namespace.
+data RawOccName = RawOccName !RawNameSpace !FastString
+
+data RawNameSpace = Constructor | Value
+-- TODO: symbols
+
+rawNameSpace :: String -> RawNameSpace
+rawNameSpace (c:_)
+    | isUpper c = Constructor
+rawNameSpace _ = Value
+
+instance IsString RawOccName where
+    fromString s = RawOccName (rawNameSpace s) (fsLit s)
+
+valueOccName, typeOccName :: RawOccName -> OccName
+valueOccName (RawOccName Constructor s) = mkDataOccFS s
+valueOccName (RawOccName Value s) = mkVarOccFS s
+typeOccName (RawOccName Constructor s) = mkTcOccFS s
+typeOccName (RawOccName Value s) = mkTyVarOccFS s
+
+-- | A newtype wrapper around 'ModuleName' which is an instance of 'IsString'.
+newtype ModuleNameStr = ModuleNameStr { unModuleNameStr :: ModuleName }
+
+instance IsString ModuleNameStr where
+    fromString = ModuleNameStr . mkModuleNameFS . fsLit
+
+-- | A string identifier which may be qualified to a particular module.
+--
+-- For example:
+--
+-- > fromString "A.b.c" == RawQual (fromString "A.b") (fromString "c")
+-- > fromString "c" == RawUnqual (fromString "c")
+--
+-- This definition is simililar to 'RdrName', but independent of whether it's
+-- in the type or value namespace.  Functions in this package that take
+-- a 'RdrName' as input will internally convert it to the proper namespace.
+data RawRdrName = RawUnqual RawOccName | RawQual ModuleNameStr RawOccName
+
+-- GHC always wraps RdrName in a Located.  (Usually: 'Located (IdP pass)')
+-- So for convenience, these functions return a Located-wrapped value.
+valueRdrName, typeRdrName :: RawRdrName -> Located RdrName
+valueRdrName (RawUnqual r) = builtLoc $ Unqual $ valueOccName r
+valueRdrName (RawQual (ModuleNameStr m) r) = builtLoc $ Qual m $ valueOccName r
+typeRdrName (RawUnqual r) = builtLoc $ Unqual $ typeOccName r
+typeRdrName (RawQual (ModuleNameStr m) r) = builtLoc $ Qual m $ typeOccName r
+
+-- TODO: operators
+instance IsString RawRdrName where
+    -- Split "Foo.Bar.baz" into ("Foo.Bar", "baz")
+    fromString f = case span (/= '.') (reverse f) of
+        (f', '.':f'') ->
+            RawQual (fromString $ reverse f'') (fromString $ reverse f')
+        _ -> RawUnqual (fromString f)
--- a/src/GHC/SourceGen/Overloaded.hs
+++ b/src/GHC/SourceGen/Overloaded.hs
@ -0,0 +1,235 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+-- | This module overloads some combinators so they can be used in
+-- different contexts: for expressions, types and/or patterns.
+module GHC.SourceGen.Overloaded
+    ( Par(..)
+    , App(..)
+    , HasTuple(..)
+    , tuple
+    , unboxedTuple
+    , HasList(..)
+    , Var(..)
+    ) where
+
+import BasicTypes (Boxity(..))
+import HsTypes
+    ( HsType(..)
+    , HsTyVarBndr(..)
+    )
+import HsSyn (IE(..), IEWrappedName(..))
+#if !MIN_VERSION_ghc(8,6,0)
+import PlaceHolder(PlaceHolder(..))
+#endif
+
+import HsSyn
+    ( HsExpr(..)
+    , Pat(..)
+    , HsTupArg(..)
+    , HsTupleSort(..)
+    )
+import DataCon (dataConName)
+import RdrName (RdrName, nameRdrName)
+import SrcLoc (Located)
+import TysWiredIn (consDataCon_RDR, nilDataCon, unitDataCon)
+
+import GHC.SourceGen.Expr.Internal
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Type.Internal
+
+-- | A class for wrapping terms in parentheses.
+class Par e where
+    par :: e -> e
+
+instance Par HsExpr' where
+    par = noExt HsPar . builtLoc
+
+instance Par Pat' where
+    par = noExt ParPat . builtPat
+
+instance Par HsType' where
+    par = noExt HsParTy . builtLoc
+
+-- | A class for term application.
+--
+-- These functions may add additional parentheses to the AST.
+-- GHC's pretty-printing functions expect those parentheses
+-- to already be present, because GHC preserves parentheses when it
+-- parses the AST from a source file.
+class App e where
+    -- | Prefix-apply a term:
+    --
+    -- > f x
+    -- > =====
+    -- > var "f" @@ var "x"
+    --
+    -- > (+) x
+    -- > =====
+    -- > var "+" @@ var "x"
+    --
+    -- Also parenthesizes the right-hand side in order to preserve its
+    -- semantics when pretty-printed, but tries to do so only when
+    -- necessary:
+    --
+    -- > f x y
+    -- > =====
+    -- > var "f" @@ var "x" @@ var "y"
+    -- > -- equivalently:
+    -- > (var "f" @@ var "x") @@ var "y"
+    --
+    -- > f (g x)
+    -- > =====
+    -- > var "f" @@ (var "g" @@ var "x")
+    --
+    -- > f (g x)
+    -- > =====
+    -- > var "f" @@ par (var "g" @@ par (var "x"))
+    (@@) :: e -> e -> e
+
+    -- | Infix-apply an operator or function.
+    --
+    -- For example:
+    --
+    -- > x + y
+    -- > =====
+    -- > op (var "x") "+" (var "y")
+    --
+    -- Also parenthesizes the right-hand side in order to preserve its
+    -- semantics when pretty-printed, but tries to do so only when necessary:
+    --
+    -- > f x + g y
+    -- > =====
+    -- > op (var "f" @@ var "x") "+" (var "g" @@ var "y")
+    --
+    -- > x + (y + z)
+    -- > =====
+    -- > op (var "x") "+" (op (var "y") "+" (var "z"))
+    --
+    -- > f x `plus` g y
+    -- > =====
+    -- > op (var "f" @@ var "x") "plus" (var "g" @@ var "y")
+    op :: e -> RawRdrName -> e -> e
+infixl 2 @@
+
+instance App HsExpr' where
+    op x o y
+        = noExt OpApp
+            (parenthesizeExprForOp $ builtLoc x)
+            (builtLoc $ var o)
+#if !MIN_VERSION_ghc(8,6,0)
+            PlaceHolder
+#endif
+            (parenthesizeExprForOp $ builtLoc y)
+    x @@ y = noExt HsApp (builtLoc x)
+                (parenthesizeExprForApp $ builtLoc y)
+
+instance App HsType' where
+    op x o y
+        = noExt HsOpTy (parenthesizeTypeForOp $ builtLoc x)
+                (typeRdrName o)
+                (parenthesizeTypeForOp $ builtLoc y)
+    x @@ y = noExt HsAppTy
+                (builtLoc x)
+                (parenthesizeTypeForApp $ builtLoc y)
+
+class HasTuple e where
+    unit :: e
+    tupleOf :: Boxity -> [e] -> e
+
+tuple, unboxedTuple :: HasTuple e => [e] -> e
+tuple = tupleOf Boxed
+unboxedTuple = tupleOf Unboxed
+
+instance HasTuple HsExpr' where
+    tupleOf b ts =
+        noExt ExplicitTuple
+            (map (builtLoc . noExt Present . builtLoc) ts)
+            b
+    unit = noExt HsVar unitDataConName
+
+unitDataConName :: Located RdrName
+unitDataConName = builtLoc $ nameRdrName $ dataConName $ unitDataCon
+
+instance HasTuple HsType' where
+    tupleOf b = noExt HsTupleTy b' . map builtLoc
+        where
+            b' = case b of
+                    Unboxed -> HsUnboxedTuple
+                    -- See the note [Unit tuples] in HsType.hs for why
+                    -- this isn't just HsBoxed.
+                    Boxed -> HsBoxedOrConstraintTuple
+    unit = tupleOf Boxed []
+
+instance HasTuple Pat' where
+    tupleOf b ps =
+        noExt TuplePat (map builtPat ps) b
+#if !MIN_VERSION_ghc(8,6,0)
+        []
+#endif
+    unit = noExt VarPat unitDataConName
+
+-- | An explicit list of terms.
+--
+-- > [x, y]
+-- > =====
+-- > list [var "x", var "y"]
+--
+-- NOTE: for types, use either @listTy@ or @promotedListTy@.
+class HasList e where
+    list :: [e] -> e
+    -- | The empty list @[]@.
+    nil :: e
+
+    -- | The list cons constructor @(:)@.
+    cons :: e
+
+-- TODO: allow something like "consOp" which applies (:) as an operator, but using
+-- the built-in RdrName.
+
+nilDataConName :: Located RdrName
+nilDataConName = builtLoc $ nameRdrName $ dataConName $ nilDataCon
+
+instance HasList HsExpr' where
+    list = withPlaceHolder (noExt ExplicitList) Nothing . map builtLoc
+    nil = noExt HsVar nilDataConName
+    cons = noExt HsVar $ builtLoc consDataCon_RDR
+
+instance HasList Pat' where
+#if MIN_VERSION_ghc(8,6,0)
+    list = noExt ListPat . map builtPat
+#else
+    list ps = ListPat (map builtPat ps) PlaceHolder Nothing
+#endif
+    nil = noExt VarPat nilDataConName
+    cons = noExt VarPat $ builtLoc $ consDataCon_RDR
+
+-- | Terms that can contain references to named things.  They may be actual variables,
+-- functions, or constructors.  For example, @'var' \"a\"@ and @'var' \"A\"@
+-- are equally valid.
+-- Depending on the context, the former could refer to either a function,
+-- value, type variable, or pattern; and the latter could refer to either a type
+-- constructor or a  data constructor,
+class Var a where
+    var :: RawRdrName -> a
+
+instance Var Pat' where
+    var = noExt VarPat . valueRdrName
+
+instance Var HsExpr' where
+    var = noExt HsVar . valueRdrName
+
+instance Var HsType' where
+    var = noExt HsTyVar notPromoted . typeRdrName
+
+instance Var HsTyVarBndr' where
+    var = noExt UserTyVar . typeRdrName
+
+instance Var IE' where
+    var = noExt IEVar . builtLoc . IEName . valueRdrName
--- a/src/GHC/SourceGen/Pat.hs
+++ b/src/GHC/SourceGen/Pat.hs
@ -0,0 +1,51 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module provides combinators for constructing Haskell patterns.
+module GHC.SourceGen.Pat where
+
+import HsTypes
+import HsPat
+
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+
+-- | A wild pattern (@_@).
+wildP :: Pat'
+wildP = noExtOrPlaceHolder WildPat
+
+-- | An as-pattern.
+--
+-- > a@B
+-- > =====
+-- > asP "a" (var "B")
+asP :: RawRdrName -> Pat' -> Pat'
+v `asP` p = noExt AsPat (valueRdrName v) $ builtPat p
+
+-- | A pattern constructor.
+--
+-- > A b c
+-- > =====
+-- > conP "A" [var "b", var "c"]
+conP :: RawRdrName -> [Pat'] -> Pat'
+conP c xs = ConPatIn (valueRdrName c) $ PrefixCon $ map builtPat xs
+
+-- | A bang-pattern.
+--
+-- > !x
+-- > =====
+-- > strictP (var x)
+strictP :: Pat' -> Pat'
+strictP = noExt BangPat . builtPat
+
+-- | A lazy pattern match.
+--
+-- > ~(A x)
+-- > =====
+-- > lazyP (conP "A" [var x])
+lazyP :: Pat' -> Pat'
+lazyP = noExt LazyPat . builtPat
--- a/src/GHC/SourceGen/Pretty.hs
+++ b/src/GHC/SourceGen/Pretty.hs
@ -0,0 +1,25 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module provides utilities for rendering GHC syntax as strings.
+module GHC.SourceGen.Pretty
+    ( showPpr
+    , putPpr
+    , hPutPpr
+    ) where
+
+import DynFlags
+import GhcMonad
+import Outputable
+import System.IO
+
+hPutPpr :: Outputable a => Handle -> a -> Ghc ()
+hPutPpr h x = do
+    dflags <- getDynFlags
+    liftIO $ printForUser dflags h neverQualify $ ppr x
+
+putPpr :: Outputable a => a -> Ghc ()
+putPpr = hPutPpr stdout
--- a/src/GHC/SourceGen/Syntax.hs
+++ b/src/GHC/SourceGen/Syntax.hs
@ -0,0 +1,109 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- | This module defines type synonyms for the different parts of GHC's syntax
+tree.
+
+GHC uses the same types at different stages of the compilation, distinguishing
+them using a type parameter.
+The functions in @ghc-source-gen@ construct values as they would appear after the
+parsing step.
+-}
+module GHC.SourceGen.Syntax where
+
+import HsSyn
+    ( HsDecl
+    , HsExpr(..)
+    , HsLit
+    , HsModule
+    , HsType(..)
+    , HsBind
+    , HsTyVarBndr
+    , HsOverLit
+    , HsValBinds
+    , HsMatchContext
+    , IE
+    , LHsQTyVars
+    , Match
+    , MatchGroup
+    , GRHS
+    , GRHSs
+    , Stmt
+    , ConDecl
+    , HsConDeclDetails
+    , LHsSigType
+    , ImportDecl
+    , LHsSigWcType
+    , LHsWcType
+    )
+import HsBinds (Sig, HsLocalBinds)
+import HsPat
+import RdrName (RdrName)
+import SrcLoc (Located)
+
+#if MIN_VERSION_ghc(8,4,0)
+import HsExtension (GhcPs)
+#endif
+
+#if MIN_VERSION_ghc(8,4,0)
+type HsExpr' = HsExpr GhcPs
+type HsLit' = HsLit GhcPs
+type HsType' = HsType GhcPs
+type HsDecl' = HsDecl GhcPs
+type HsModule' = HsModule GhcPs
+type HsBind' = HsBind GhcPs
+type HsLocalBinds' = HsLocalBinds GhcPs
+type HsValBinds' = HsValBinds GhcPs
+type Sig' = Sig GhcPs
+type Pat' = Pat GhcPs
+type HsMatchContext' = HsMatchContext RdrName
+type Match' = Match GhcPs
+type MatchGroup' = MatchGroup GhcPs
+type GRHS' = GRHS GhcPs
+type GRHSs' = GRHSs GhcPs
+type Stmt' = Stmt GhcPs (Located HsExpr')
+type HsTyVarBndr' = HsTyVarBndr GhcPs
+type HsOverLit' = HsOverLit GhcPs
+type LHsQTyVars' = LHsQTyVars GhcPs
+type ConDecl' = ConDecl GhcPs
+type HsConDeclDetails' = HsConDeclDetails GhcPs
+type LHsSigType' = LHsSigType GhcPs
+type IE' = IE GhcPs
+type ImportDecl' = ImportDecl GhcPs
+type LHsSigWcType' = LHsSigWcType GhcPs
+type LHsWcType' = LHsWcType GhcPs
+
+#else
+type HsExpr' = HsExpr RdrName
+type HsLit' = HsLit
+type HsType' = HsType RdrName
+type HsDecl' = HsDecl RdrName
+type HsModule' = HsModule RdrName
+type HsBind' = HsBind RdrName
+type HsLocalBinds' = HsLocalBinds RdrName
+type HsValBinds' = HsValBinds RdrName
+type Sig' = Sig RdrName
+type Pat' = Pat RdrName
+type HsMatchContext' = HsMatchContext RdrName
+type Match' = Match RdrName
+type MatchGroup' = MatchGroup RdrName
+type GRHS' = GRHS RdrName
+type GRHSs' = GRHSs RdrName
+type Stmt' = Stmt RdrName (Located HsExpr')
+type HsTyVarBndr' = HsTyVarBndr RdrName
+type HsOverLit' = HsOverLit RdrName
+type LHsQTyVars' = LHsQTyVars RdrName
+type ConDecl' = ConDecl RdrName
+type HsConDeclDetails' = HsConDeclDetails RdrName
+type LHsSigType' = LHsSigType RdrName
+type IE' = IE RdrName
+type ImportDecl' = ImportDecl RdrName
+type LHsSigWcType' = LHsSigWcType RdrName
+type LHsWcType' = LHsWcType RdrName
+
+#endif
--- a/src/GHC/SourceGen/Syntax/Internal.hs
+++ b/src/GHC/SourceGen/Syntax/Internal.hs
@ -0,0 +1,73 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+module GHC.SourceGen.Syntax.Internal where
+
+import SrcLoc (SrcSpan, Located, GenLocated(..), mkGeneralSrcSpan)
+
+#if MIN_VERSION_ghc(8,8,0)
+import BasicTypes (PromotionFlag(..))
+#else
+import HsTypes (Promoted(..))
+#endif
+
+#if MIN_VERSION_ghc(8,6,0)
+import HsExtension (NoExt(NoExt))
+#else
+import PlaceHolder(PlaceHolder(..))
+#endif
+import GHC.SourceGen.Syntax
+
+#if MIN_VERSION_ghc(8,6,0)
+noExt :: (NoExt -> a) -> a
+noExt = ($ NoExt)
+
+noExtOrPlaceHolder :: (NoExt -> a) -> a
+noExtOrPlaceHolder = noExt
+
+withPlaceHolder :: a -> a
+withPlaceHolder = id
+
+#else
+
+noExt :: a -> a
+noExt = id
+
+noExtOrPlaceHolder :: (PlaceHolder -> a) -> a
+noExtOrPlaceHolder = withPlaceHolder
+
+withPlaceHolder :: (PlaceHolder -> a) -> a
+withPlaceHolder = ($ PlaceHolder)
+
+#endif
+
+builtSpan :: SrcSpan
+builtSpan = mkGeneralSrcSpan "<ghc-source-gen>"
+
+builtLoc :: e -> Located e
+builtLoc = L builtSpan
+
+-- In GHC-8.8, source locations for Pat aren't stored in each node, and
+-- LPat is a synonym for Pat.
+#if MIN_VERSION_ghc(8,8,0)
+builtPat :: Pat' -> Pat'
+builtPat = id
+#else
+builtPat :: Pat' -> Located Pat'
+builtPat = builtLoc
+#endif
+
+#if MIN_VERSION_ghc(8,8,0)
+promoted, notPromoted :: PromotionFlag
+promoted = IsPromoted
+notPromoted = NotPromoted
+#else
+promoted, notPromoted :: Promoted
+promoted = Promoted
+notPromoted = NotPromoted
+#endif
--- a/src/GHC/SourceGen/Type.hs
+++ b/src/GHC/SourceGen/Type.hs
@ -0,0 +1,54 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | This module provides combinators for constructing Haskell types.
+module GHC.SourceGen.Type where
+
+import Data.String (fromString)
+import HsTypes
+
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Lit.Internal (noSourceText)
+import GHC.SourceGen.Name.Internal
+import GHC.SourceGen.Type.Internal
+
+-- | A promoted name, for example from the @DataKinds@ extension.
+tyPromotedVar :: RawRdrName -> HsType'
+tyPromotedVar = noExt HsTyVar notPromoted . typeRdrName
+
+stringTy :: String -> HsType'
+stringTy = noExt HsTyLit . noSourceText HsStrTy . fromString
+
+numTy :: Integer -> HsType'
+numTy = noExt HsTyLit . noSourceText HsNumTy
+
+listTy :: HsType' -> HsType'
+listTy = noExt HsListTy . builtLoc
+
+listPromotedTy :: [HsType'] -> HsType'
+listPromotedTy = withPlaceHolder (noExt HsExplicitListTy notPromoted) . map builtLoc
+
+-- | A function type.
+--
+-- > a -> b
+-- > =====
+-- > var "a" --> var "b"
+(-->) :: HsType' -> HsType' -> HsType'
+a --> b = noExt HsFunTy (parenthesizeTypeForFun $ builtLoc a) (builtLoc b)
+
+infixr 0 -->
+
+forall' :: [HsTyVarBndr'] -> HsType' -> HsType'
+forall' ts = noExt HsForAllTy (map builtLoc ts) . builtLoc
+
+-- | Qualify a type with constraints.
+--
+-- > (F x, G x) => x
+-- > =====
+-- > [var "F" @@ var "x", var "G" @@ var "x"] ==> var "x"
+(==>) :: [HsType'] -> HsType' -> HsType'
+(==>) cs = noExt HsQualTy (builtLoc (map builtLoc cs)) . builtLoc
--- a/src/GHC/SourceGen/Type/Internal.hs
+++ b/src/GHC/SourceGen/Type/Internal.hs
@ -0,0 +1,64 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+{-# LANGUAGE CPP #-}
+module GHC.SourceGen.Type.Internal where
+
+import HsTypes
+import SrcLoc (Located, unLoc)
+
+import GHC.SourceGen.Syntax
+import GHC.SourceGen.Syntax.Internal
+import GHC.SourceGen.Name.Internal
+
+mkQTyVars :: [RawRdrName] -> LHsQTyVars'
+mkQTyVars vars =  withPlaceHolder
+                $ noExt (withPlaceHolder HsQTvs)
+                $ map (builtLoc . noExt UserTyVar . typeRdrName)
+                    vars
+
+sigType :: HsType' -> LHsSigType'
+sigType t = withPlaceHolder $ noExt (withPlaceHolder HsTypes.HsIB) $ builtLoc t
+
+
+-- TODO: GHC >= 8.6 provides parenthesizeHsType.  For consistency with
+-- older versions, we're implementing our own parenthesis-wrapping.
+-- Once we stop supporting GHC-8.4, we can switch to that implementation.
+
+parenthesizeTypeForApp, parenthesizeTypeForOp, parenthesizeTypeForFun
+    :: Located HsType' -> Located HsType'
+parenthesizeTypeForApp t
+    | needsParenForApp (unLoc t) = parTy t
+    | otherwise = t
+parenthesizeTypeForOp t
+    | needsParenForOp (unLoc t) = parTy t
+    | otherwise = t
+parenthesizeTypeForFun t
+    | needsParenForFun (unLoc t) = parTy t
+    | otherwise = t
+
+needsParenForFun, needsParenForOp, needsParenForApp
+    :: HsType' -> Bool
+needsParenForFun t = case t of
+    HsForAllTy{} -> True
+    HsQualTy{} -> True
+    HsFunTy{} -> True
+    _ -> False
+needsParenForOp t = case t of
+    HsOpTy{} -> True
+    _ -> needsParenForFun t
+needsParenForApp t = case t of
+    HsAppTy {} -> True
+    _ -> needsParenForOp t
+
+parTy :: Located HsType' -> Located HsType'
+parTy = builtLoc . noExt HsParTy
+
+sigWcType :: HsType' -> LHsSigWcType'
+sigWcType = noExt (withPlaceHolder HsTypes.HsWC) . sigType
+
+wcType :: HsType' -> LHsWcType'
+wcType = noExt (withPlaceHolder HsTypes.HsWC) . builtLoc
--- a/stack-8.8.yaml
+++ b/stack-8.8.yaml
@ -0,0 +1,45 @@
+# Copyright 2019 Google LLC
+#
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file or at
+# https://developers.google.com/open-source/licenses/bsd
+
+resolver: ghc-8.8.0.20190613
+packages:
+- .
+- ghc-show-ast
+
+setup-info:
+  ghc:
+    macosx:
+        8.8.0.20190613:
+            url: "https://downloads.haskell.org/~ghc/8.8.1-alpha2/ghc-8.8.0.20190613-x86_64-apple-darwin.tar.xz"
+            content-length: 184846152
+            sha1: 116bdaadcde045f78adcf1ffce291c79fb1c3eb6
+            sha256: 04b5b4dc35db2bc26f5e4d46946409a5d21f47a7923bf69ee31b093b7e71e889
+
+allow-newer: true
+compiler: ghc-8.8.0.20190613
+
+extra-deps:
+- git: https://github.com/pcapriotti/optparse-applicative.git
+  commit: 83e096aa20cd4fd5328bf11c266115326d584e00
+# For compatibility with newer Cabal:
+- git: https://github.com/simonmar/ghc-paths.git
+  commit: 3c867c34b6f505a500cc63bba5161b97aa0a9177
+- ansi-wl-pprint-0.6.9@sha256:0b225cd1dc7afc3d73e428f7c0473a176adeeb8b9584a74379211832cd492689,2364
+- colour-2.3.5@sha256:b27db0a3ad40d70bdbd8510a104269f8707592e80757a1abc66a22ba25e5a42f,1801
+- hashable-1.3.0.0@sha256:7ad8edaa681e81162ddddb4d703a9cffe6a0c9ddcfede31cf6569507ed3f1ddb,5179
+- transformers-compat-0.6.5@sha256:50b00c57bf3fc379ec2477bfc261a2aebc983084488478adb29854f193af4696,5490
+- ansi-terminal-0.9.1@sha256:48f53532d0f365ffa568c8cf0adc84c66f800a7d80d3329e4f04fa75392f4af1,3225
+- async-2.2.2@sha256:ed46f0f5be36cf8a3e3aebc6827d015e1f3bf9615c245e057b9e9bd35faddd21,2895
+- call-stack-0.1.0@sha256:3453a0c5ed3a7a7de0cc0703907e05bd251c766cce8a38efe41b7188d228e3fa,1109
+- clock-0.8@sha256:b4ae207e2d3761450060a0d0feb873269233898039c76fceef9cc1a544067767,4113
+- tagged-0.8.6@sha256:7093ee39c9779beeacffa4b0035a0e8a25da16afcd1c1a876930207fb8e31d1c,2606
+- unbounded-delays-0.1.1.0@sha256:8e57c6ffb72ed605b85c69d3b3a7ebbbbb70bfb5e9b9816309f1f733240838f2,1184
+- wcwidth-0.0.2@sha256:77531eb6683c505c22ab3fa11bbc43d3ce1e7dac21401d4d5a19677d348bb5f3,1998
+- tasty-1.2.3@sha256:bba67074e5326d57e8f53fc1dabcb6841daa4dc51b053506eb7f40a6f49a0497,2517
+- tasty-hunit-0.10.0.2@sha256:8e8bd5807cec650f5aebc5ada07b57620c863e69145e65249651c1b48d97bd70,1515
+
+ghc-options:
+  "$locals": -Wall -Werror
--- a/stack.yaml
+++ b/stack.yaml
@ -0,0 +1,13 @@
+# Copyright 2019 Google LLC
+#
+# Use of this source code is governed by a BSD-style
+# license that can be found in the LICENSE file or at
+# https://developers.google.com/open-source/licenses/bsd
+
+resolver: lts-13.23
+packages:
+- .
+- ghc-show-ast
+
+ghc-options:
+  "$locals": -Wall -Werror
--- a/tests/pprint_examples.hs
+++ b/tests/pprint_examples.hs
@ -0,0 +1,219 @@
+-- Copyright 2019 Google LLC
+--
+-- Use of this source code is governed by a BSD-style
+-- license that can be found in the LICENSE file or at
+-- https://developers.google.com/open-source/licenses/bsd
+
+-- | Simple example using this package
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module Main (main) where
+
+import GHC.Paths (libdir)
+import GHC (runGhc)
+import Outputable (Outputable)
+
+import GHC.SourceGen
+
+main :: IO ()
+main = mapM_ run [test1, test2, test3, test4, test5]
+  where
+    run act = putStrLn "========" >> act
+
+pprint :: Outputable a => a -> IO ()
+pprint x = runGhc (Just libdir) $ putPpr x
+
+test1 :: IO ()
+test1 = pprint $ tuple
+    [ var "Foo.abc"
+    , overLabel "def"
+    , char 'g'
+    , let' [ typeSig "result" $ var "A" @@ var "B"
+           , funBind "result"
+                $ matchRhs [var "x", wildP]
+                    $ var "foo" @@ char 'c'
+           ]
+        (var "result")
+    ]
+
+test2 :: IO ()
+test2 = pprint $ module' (Just "Foo") (Just [var "efg"]) []
+    [ typeSigs ["efg", "h"] $ tuple [var "A", var "B"]
+    , funBind "efg"
+        $ matchRhs [] (char 'a')
+            `where'` [ typeSig "q" $ var "Q"
+                     , funBind "q" $ match [] [guarded [stmt $ var "True"] $ rhs (char 'q')]
+                     ]
+    , funBind "f"
+        $ matchRhs [var "x", var "y"]
+            (case' (var "y")
+                        [matchRhs [wildP] $ var "x"])
+            `where'` [funBind "q" $ matchRhs [] $ char 't']
+    ]
+
+test3 :: IO ()
+test3 = pprint $ module' Nothing Nothing []
+    [ funBind "lambdas" $ matchRhs [] $ lambda [var "y"]
+                    $ lambdaCase [matchRhs [var "z"] (char 'a')]
+    , funBinds "ifs"
+        [ matchRhs [var "x"] $ if' (var "b") (var "t") (var "f")
+        , matchRhs [var "y"] $ multiIf [guardedStmt (var "False")
+                                            $ rhs (char 'f')
+                                        , guardedStmt (var "True")
+                                            $ rhs (char 't')
+                                        ]
+        , matchRhs [var "z"] $ multiIf
+            [ guardedStmt (var "f" @@ var "x") $ rhs (string "f")
+            , guardedStmt (var "g" @@ var "x") $ rhs (string "g")
+            , guardedStmt (var "otherwise") $ rhs (string "h")
+            ]
+        ]
+    , funBind "do'"
+        $ matchRhs [] (do' [ var "x" <-- var "act"
+                        , stmt $ var "return" @@ var "x"
+                        ])
+    , typeSig "types"
+        $ forall' [var "x", var "y"]
+        $ [var "Show" @@ var "x"] ==> var "y"
+    , typeSig "types'"
+        $ [var "Show" @@ var "x"] ==>
+            (forall' [var "x", var "y"]
+                $ var "y")
+    , funBind "swap"
+        $ matchRhs [tuple [var "x", var "y"]]
+            $ tuple [var "y", var "x"]
+    , funBind "char" $ matchRhs [char 'a'] (char 'b')
+    , funBind "string" $ matchRhs [string "abc"] (string "def")
+    , funBind "as"
+        $ matchRhs [asP "x" (tuple [var "y", var "z"])]
+            (var "x")
+    , funBind "con"
+        $ matchRhs [conP "A" [var "b", conP "C" [var "d"]]]
+            $ tuple [var "b", var "d"]
+    , funBind "ops"
+        $ matchRhs [var "x", var "y"]
+            $ op (var "x") "+" (var "y")
+    , funBinds "ops'"
+        [ matchRhs [] (op (int 1) "*"
+                        (op (int 2) "+" (int 3)))
+        , matchRhs [] (op (var "A" @@ var "x") "*"
+                        (op (var "B" @@ var "y") "+"
+                                 (var "C" @@ var "z")))
+        , matchRhs [] (op (var "A" @@ var "x") "mult"
+                        (op (var "B" @@ var "y") "+"
+                                 (var "C" @@ var "z")))
+        ]
+    , funBinds "cons'"
+        [ matchRhs [] (var "X" @@ int 1 @@
+                        (var "Y" @@ int 2 @@ int 3)
+                        @@ var "Z")
+        , matchRhs [] (var "f" @@ par (var "g" @@ var "x"))
+        ]
+    , typeSig "f" $ var "X" @@ var "a" @@
+                        (var "Y" @@ var "b" @@ var "c")
+                        @@ var "Z"
+    , typeSig "g" $ op (var "A" @@ var "x") "*"
+                        (op (var "B" @@ var "y") "+"
+                                 (var "C" @@ var "z"))
+    , class' [var "A" @@ var "a"] "B" ["b", "b'"]
+        [ typeSig "f" $ var "b" --> var "b'"
+        , funBind "f" $ matchRhs [] $ var "id"
+        ]
+    , class' [] "F" ["a", "b", "c"]
+        [ funDep ["a", "b"] ["c"]
+        , funDep ["a"] ["b", "c"]
+        ]
+    , class' [] "Ident" ["a", "b"]
+        [ funDep ["a"] ["b"]
+        , funDep ["b"] ["a"]
+        , typeSig "ident" $ var "a" --> var "b"
+        ]
+    , type' "A" ["b", "c"] $ var "D"
+    , data' "A" ["b", "c"]
+        [ prefixCon "A" [field (var "b"), field (var "c")]
+        , prefixCon "D" []
+        ]
+    , newtype' "A" ["b", "c"] (prefixCon "A" [field (var "b")])
+    , instance' (var "A" @@ var "b" @@ var "c")
+        [ typeSig "f" $ var "b" --> var "c"
+        , funBind "f" $ matchRhs [] $ var "undefined"
+        ]
+    , let a = var "a"
+      in class'
+           [var "Real" @@ a, var "Enum" @@ a]
+           "Integral"
+           ["a"]
+           [ typeSig "divMod" $ a --> a --> tuple [a, a]
+           , typeSig "div" $ a --> a --> a
+           , funBind "div"
+               $ matchRhs [var "x", var "y"]
+                  $ var "fst" @@ (var "divMod" @@ var "x" @@ var "y")
+           ]
+    , instance' (var "Show" @@ var "Bool")
+        [ typeSig "show" $ var "Bool" --> var "String"
+        , funBinds "show"
+            [ matchRhs [var "True"] $ string "True"
+            , matchRhs [var "False"] $ string "False"
+            ]
+        ]
+    , data' "X" ["b"]
+        [ prefixCon "X"
+            [ field $ var "A" @@ var "b"
+            , strict $ field $ var "A" @@ var "b"
+            , lazy $ field $ var "A" @@ var "b"
+            ]
+        , prefixCon ":+"
+            [ field $ var "A" @@ var "b"
+            , strict $ field $ var "A" @@ var "b"
+            , lazy $ field $ var "A" @@ var "b"
+            ]
+        , infixCon
+            (strict $ field $ var "A" @@ var "b")
+            "Y"
+            (lazy $ field $ var "A" @@ var "b")
+        , infixCon
+            (strict $ field $ var "A" @@ var "b")
+            ":*"
+            (lazy $ field $ var "A" @@ var "b")
+        , infixCon
+            (field $ var "A" @@ var "b")
+            ":*"
+            (field $ var "A" @@ var "b")
+        , recordCon "Z"
+            [ ("x", field $ var "Int")
+            , ("y", field $ var "A" @@ var "b")
+            , ("y", strict $ field $ var "A" @@ var "b")
+            , ("y", lazy $ field $ var "A" @@ var "b")
+            ]
+        ]
+    , funBind "strictness"
+        $ matchRhs
+            [strictP (conP "A" [var "b"]),
+             lazyP (conP "A" [var "b"])
+            ] (char 'x')
+    , typeSig "unit" $ unit --> unit
+    , funBind "unit" $ matchRhs [unit] unit
+    ]
+
+test4 :: IO ()
+test4 = pprint constModule
+
+test5 :: IO ()
+test5 = pprint $ module' (Just "M") (Just exports) imports []
+  where
+    exports = [var "a", var "b"]
+    imports = [ qualified' $ import' "A"
+              , import' "B" `as'` "C"
+              , import' "D" `exposing` [var "d"]
+              , import' "E" `hiding` [var "e"]
+              ]
+
+constModule :: HsModule'
+constModule = module' (Just "Const") (Just [var "const"]) []
+    [ typeSig "const" $ a --> b --> a
+    , funBind "const" $ matchRhs [wildP, x] x
+    ]
+  where
+    a = var "a"
+    b = var "b"
+    x = var "x"
--- a/tests/pprint_test.hs
+++ b/tests/pprint_test.hs
@ -0,0 +1,135 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main(main) where
+
+import DynFlags (getDynFlags)
+import GhcMonad (liftIO)
+import GHC.Paths (libdir)
+import GHC (runGhc, DynFlags)
+import Outputable (Outputable)
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import GHC.SourceGen
+
+data TestCase a = String :~ a
+
+infixr 0 :~
+
+testCases :: Outputable a => DynFlags -> String -> [TestCase a] -> TestTree
+testCases dflags name cases = testCase name $ mapM_ run cases
+  where
+    run (expected :~ x) = expected @=? showPpr dflags x
+
+testTypes :: DynFlags ->  String -> [TestCase HsType'] -> TestTree
+testTypes = testCases
+
+testExprs :: DynFlags ->  String -> [TestCase HsExpr'] -> TestTree
+testExprs = testCases
+
+main :: IO ()
+main = runGhc (Just libdir) $ do
+    dflags <- getDynFlags
+    liftIO $ defaultMain $ testGroup "Tests"
+        [typesTest dflags, exprsTest dflags]
+
+typesTest, exprsTest :: DynFlags -> TestTree
+typesTest dflags = testGroup "Type"
+    [ test "var"
+        [ "A" :~ var "A"
+        , "x" :~ var "x"
+        , "A.x" :~ var "A.x"
+        , "x" :~ var (unqual "x")
+        , "A.x" :~ var (qual "A" "x")
+        ]
+    , test "app"
+        [ "A x" :~ var "A" @@ var "x"
+        , "(+) x" :~ var "+" @@ var "x"
+        , "A (B x)" :~ var "A" @@ par (var "B" @@ var "x")
+        , "A x (B y z)" :~ var "A" @@ var "x" @@ (var "B" @@ var "y" @@ var "z")
+        , "A w (B x y) Z"
+            :~ var "A" @@ var "w" @@ (var "B" @@ var "x" @@ var "y") @@ var "Z"
+        ]
+    , test "op"
+        [ "x + y" :~ op (var "x") "+" (var "y")
+        , "x `add` y" :~ op (var "x") "add" (var "y")
+        , "x * (y + z)" :~ op (var "x") "*" (op (var "y") "+" (var "z"))
+        , "x `mult` (y `add` z)" :~ op (var "x") "mult" (op (var "y") "add" (var "z"))
+        , "A x * (B y + C z)" :~ op (var "A" @@ var "x") "*"
+                                    (op (var "B" @@ var "y") "+" (var "C" @@ var "z"))
+        ]
+    , test "function"
+        [ "a -> b" :~ var "a" --> var "b"
+        , "a -> b -> c" :~ var "a" --> var "b" --> var "c"
+        , "a -> b -> c" :~ var "a" --> (var "b" --> var "c")
+        , "(a -> b) -> c" :~ (var "a" --> var "b") --> var "c"
+        ]
+    , test "literals"
+        [ "\"abc\"" :~ stringTy "abc"
+        , "123" :~ numTy 123
+        ]
+    , test "unit"
+        [ "()" :~ unit ]
+   , test "list"
+        [ "[x]" :~ listTy (var "x")
+        , "[]" :~ listPromotedTy []
+        , "[x]" :~ listPromotedTy [var "x"]
+        , "[y, z]" :~ listPromotedTy [var "y", var "z"]
+        ]
+    ]
+  where
+    test = testTypes dflags
+
+exprsTest dflags = testGroup "Expr"
+    [ test "var"
+        [ "A" :~ var "A"
+        , "x" :~ var "x"
+        , "A.x" :~ var "A.x"
+        , "x" :~ var (unqual "x")
+        , "A.x" :~ var (qual "A" "x")
+        ]
+    , test "app"
+        [ "A x" :~ var "A" @@ var "x"
+        , "(+) x" :~ var "+" @@ var "x"
+        , "A (B x)" :~ var "A" @@ par (var "B" @@ var "x")
+        , "A x (B y z)" :~ var "A" @@ var "x" @@ (var "B" @@ var "y" @@ var "z")
+        , "A w (B x y) Z"
+            :~ var "A" @@ var "w" @@ (var "B" @@ var "x" @@ var "y") @@ var "Z"
+        , "A 3" :~ var "A" @@ int 3
+        , "A (-3)" :~ var "A" @@ int (-3)
+        , "A (3 % 1)" :~ var "A" @@ frac 3.0
+        , "A ((-3) % 1)" :~ var "A" @@ frac (-3.0)
+        , "A 'x'" :~ var "A" @@ char 'x'
+        , "A \"xyz\"" :~ var "A" @@ string "xyz"
+        ]
+    , test "op"
+        [ "x + y" :~ op (var "x") "+" (var "y")
+        , "x `add` y" :~ op (var "x") "add" (var "y")
+        , "x * (y + z)" :~ op (var "x") "*" (op (var "y") "+" (var "z"))
+        , "x `mult` (y `add` z)" :~ op (var "x") "mult" (op (var "y") "add" (var "z"))
+        , "A x * (B y + C z)" :~ op (var "A" @@ var "x") "*"
+                                    (op (var "B" @@ var "y") "+" (var "C" @@ var "z"))
+        ]
+    , test ":@@:"
+        -- TODO: GHC puts extra space here.
+        [ "  e :: t" :~ var "e" @::@ var "t" ]
+    , test "unit"
+        [ "()" :~ unit ]
+    , test "list"
+        [ "[]" :~ list []
+        , "[]" :~ nil
+        , "[x]" :~ list [var "x"]
+        , "[y, z]" :~ list [var "y", var "z"]
+        , "(:)" :~ cons
+        , "(:) x y" :~ cons @@ var "x" @@ var "y"
+        ]
+    , test "tyApp"
+        [ "x @a" :~ tyApp (var "x") (var "a")
+        , "x @a @b" :~ tyApp (tyApp (var "x") (var "a")) (var "b")
+        , "x @a b" :~ tyApp (var "x") (var "a") @@ var "b"
+        , "x @(a b)" :~ tyApp (var "x") (var "a" @@ var "b")
+        , "x @(a + b)" :~ tyApp (var "x") (op (var "a") "+" (var "b"))
+        ]
+    ]
+  where
+    test = testExprs dflags