~jojo/Carth

ae1d242d7d48292779dcbd953e5864bb4211e1ca — JoJo 3 months ago 2219ea5
Update stackage release & use default-extensions in cabal file

Also, fix some minor breakages caused by ghc update, fix the
literate.org example, fix some new warnings, and get rid of the need
for a bunch of Data implementations by using basic parsing functions
in SystemSpec.hs.
M carth.cabal => carth.cabal +44 -35
@@ 53,7 53,7 @@ library
  other-modules:
  hs-source-dirs:
      src
  ghc-options: -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists
  ghc-options: -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-compat-unqualified-imports
  build-depends:
      base
    , bytestring


@@ 67,11 67,23 @@ library
    , megaparsec
    , microlens-platform
    , mtl
    , parser-combinators
    , prettyprinter
    , process
    , template-haskell
    , utf8-string
    , prettyprinter
    , parser-combinators
  default-extensions:
      LambdaCase
    , TupleSections
    , FlexibleContexts
    , FlexibleInstances
    , OverloadedStrings
    , RankNTypes
    , MultiParamTypeClasses
    , TypeSynonymInstances
    , KindSignatures
    , GeneralizedNewtypeDeriving
    , TypeFamilies
    , TypeApplications
  default-language: Haskell2010

executable carth


@@ 81,30 93,27 @@ executable carth
      Prebaked
  hs-source-dirs:
      app
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-compat-unqualified-imports
  build-depends:
      base
    , bytestring
    , carth
    , containers
    , directory
    , filepath
    , llvm-hs
    , llvm-hs-pure
    , megaparsec
    , microlens-platform
    , mtl
    , process
    , template-haskell
    , utf8-string
    , parser-combinators

    -- Testing dependencies. I have them here to not require rebuild between `stack build`
    -- & `stack test`.
    , QuickCheck
    , hspec
    , hspec-discover
    , silently
  default-extensions:
      LambdaCase
    , TupleSections
    , FlexibleContexts
    , FlexibleInstances
    , OverloadedStrings
    , RankNTypes
    , MultiParamTypeClasses
    , TypeSynonymInstances
    , KindSignatures
    , GeneralizedNewtypeDeriving
    , TypeFamilies
    , TypeApplications
  default-language: Haskell2010

test-suite carth-test


@@ 114,26 123,26 @@ test-suite carth-test
      SystemSpec
  hs-source-dirs:
      test
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists
  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Weverything -Werror -Wno-safe -Wno-unsafe -Wno-missing-import-lists -Wno-missing-exported-signatures -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-implicit-prelude -Wno-name-shadowing -Wno-orphans -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unticked-promoted-constructors -Wno-missing-deriving-strategies -Wno-missing-export-lists -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-compat-unqualified-imports
  build-depends:
      base
    , bytestring
    , carth
    , containers
    , directory
    , filepath
    , llvm-hs
    , llvm-hs-pure
    , megaparsec
    , microlens-platform
    , mtl
    , process
    , template-haskell
    , utf8-string
    , parser-combinators

    , QuickCheck
    , hspec
    , hspec-discover
    , silently
  default-extensions:
      LambdaCase
    , TupleSections
    , FlexibleContexts
    , FlexibleInstances
    , OverloadedStrings
    , RankNTypes
    , MultiParamTypeClasses
    , TypeSynonymInstances
    , KindSignatures
    , GeneralizedNewtypeDeriving
    , TypeFamilies
    , TypeApplications
  default-language: Haskell2010

M examples/literate.org => examples/literate.org +7 -7
@@ 13,21 13,21 @@ explicitly won't hurt.

#+BEGIN_SRC carth :tangle yes
(define main
  (display (id "Literate programming rules!")))
  (display (identity "Literate programming rules!")))
#+END_SRC

* The ~id~ function
  ~id~ is the identity function. It returns its argument unchanged.
* The ~identity~ function
  The ~identity~ function returns its argument unchanged.

  #+BEGIN_SRC carth
  (define (id x) x)
  (define (identity x) x)
  #+END_SRC

* How not to use ~id~
  Here is an example of how not to use ~id~. Note that this won't
* How not to use ~identity~
  Here is an example of how not to use ~identity~. Note that this won't
  compile. We show this in a SRC block to get syntax highlighting etc,
  but as ~tangle~ is ~no~, this source block will be ignored by carth.

  #+BEGIN_SRC carth :tangle no
  (display id)
  (display identity)
  #+END_SRC

M src/Check.hs => src/Check.hs +1 -1
@@ 1,4 1,4 @@
{-# LANGUAGE LambdaCase, DataKinds, TupleSections, FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}

module Check (typecheck) where


M src/Checked.hs => src/Checked.hs +2 -4
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase #-}

module Checked
    ( module Checked
    , TVar(..)


@@ 67,7 65,7 @@ data Expr'
    deriving (Show)

data Expr = Expr (Maybe SrcPos) Expr'
    deriving (Show)
    deriving Show


builtinExterns :: Map String Type


@@ 87,7 85,7 @@ type TypeDefs = Map String ([TVar], [[Type]])
type Externs = Map String (Type, SrcPos)

data Program = Program Defs TypeDefs Externs
    deriving (Show)
    deriving Show


flattenDefs :: Defs -> [(String, WithPos (Scheme, Expr))]

M src/Codegen.hs => src/Codegen.hs +1 -1
@@ 1,4 1,4 @@
{-# LANGUAGE OverloadedStrings, LambdaCase, TupleSections, FlexibleContexts, RankNTypes, DuplicateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}

-- | Generation of LLVM IR code from our monomorphic AST.
module Codegen (codegen) where

M src/Compile.hs => src/Compile.hs +3 -3
@@ 1,5 1,4 @@
{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings, LambdaCase
           , OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Compile (compile, run) where



@@ 161,7 160,8 @@ orcJitModule cfg tm mod = do
--   running process, which includes all shared object code added with
--   `Linking.loadLibraryPermanently`. Disjoint from the compile and linking
--   layer.
resolver :: CompileLayer cl => cl -> MangledSymbol -> IO (Either JITSymbolError JITSymbol)
resolver
    :: CompileLayer cl => cl -> MangledSymbol -> IO (Either JITSymbolError JITSymbol)
resolver compLay symb =
    let
        flags = JITSymbolFlags { jitSymbolWeak = False

M src/Err.hs => src/Err.hs +1 -1
@@ 1,4 1,4 @@
{-# LANGUAGE LambdaCase, FlexibleContexts, DataKinds #-}
{-# LANGUAGE DataKinds #-}

module Err (module Err, TypeErr(..), GenErr(..)) where


M src/Extern.hs => src/Extern.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE OverloadedStrings, LambdaCase, TupleSections, FlexibleContexts #-}

-- | Codegeneration related to external C function declarations
--
--   `extern` forms are translated pretty literally to extern declarations,

M src/FreeVars.hs => src/FreeVars.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE MultiParamTypeClasses, LambdaCase #-}

module FreeVars where

import qualified Data.Set as Set

M src/Gen.hs => src/Gen.hs +12 -10
@@ 1,5 1,4 @@
{-# LANGUAGE OverloadedStrings, LambdaCase, TupleSections, FlexibleContexts
           , TemplateHaskell, DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell, DuplicateRecordFields #-}

-- | Code generation operations, generally not restricted to be used with AST
--   inputs. Basically an abstraction over llvm-hs. Reusable operations that can


@@ 122,7 121,8 @@ instance Typed Val where
--
--   The signature definition, the parameter-loading, and the result return are
--   all done according to the calling convention.
genFunDef :: (Name, [TypedVar], SrcPos, TypedVar, Gen Type) -> Gen' (Global, [Definition])
genFunDef
    :: (Name, [TypedVar], SrcPos, TypedVar, Gen Type) -> Gen' (Global, [Definition])
genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
    assign currentBlockLabel (mkName "entry")
    assign currentBlockInstrs []


@@ 201,11 201,11 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
        let SrcPos path line _ _ = dpos
            -- TODO: Maybe only define this once and cache MDRef somewhere?
            fileNode =
                    let (dir, file) = splitFileName path
                    in  LLOp.File { LLOp.filename = fromString file
                                  , LLOp.directory = fromString dir
                                  , LLOp.checksum = Nothing
                                  }
                let (dir, file) = splitFileName path
                in  LLOp.File { LLOp.filename = fromString file
                              , LLOp.directory = fromString dir
                              , LLOp.checksum = Nothing
                              }
        in  LLOp.Subprogram { LLOp.scope = Just (MDInline (LLOp.DIFile fileNode))
                            , LLOp.name = nameSBString name
                            , LLOp.linkageName = nameSBString name


@@ 237,7 237,8 @@ genTailWrapInLambdas rt fvs ps genBody =
    genWrapInLambdas rt fvs ps genBody >>= getLocal >>= \r ->
        commitFinalFuncBlock (ret r) $> typeOf r

genWrapInLambdas :: Type -> [TypedVar] -> [Ast.Type] -> ([TypedVar] -> Gen Val) -> Gen Val
genWrapInLambdas
    :: Type -> [TypedVar] -> [Ast.Type] -> ([TypedVar] -> Gen Val) -> Gen Val
genWrapInLambdas rt fvs pts genBody = case pts of
    [] -> genBody fvs
    (pt : pts') -> do


@@ 484,7 485,8 @@ genAppBuiltinVirtual (TypedVar g t) aes = do
                    apps Nothing f as
    let wrap1 (xt, rt, f) = wrap [xt] rt (\xs -> f (xs !! 0))
    let wrap2 (x0t, x1t, rt, f) = wrap [x0t, x1t] rt (\xs -> f (xs !! 0) (xs !! 1))
    let noInst = throwError $ NoBuiltinVirtualInstance
    let noInst :: Gen a
        noInst = throwError $ NoBuiltinVirtualInstance
            (fromMaybe
                (ice "genAppBuiltinVirtual: no srcpos when throwing noInst error!")
                pos

M src/Infer.hs => src/Infer.hs +5 -6
@@ 1,5 1,4 @@
{-# LANGUAGE LambdaCase, TemplateHaskell, DataKinds, FlexibleContexts, TupleSections
           , RankNTypes #-}
{-# LANGUAGE TemplateHaskell, DataKinds #-}

module Infer (inferTopDefs, checkType', checkType'') where



@@ 67,10 66,10 @@ inferTopDefs tdefs ctors externs defs =
            , _envCtors = ctors
            }
        freshTvs =
                let ls = "abcdehjkpqrstuvxyz"
                    ns = map show [1 :: Word .. 99]
                    vs = [ l : n | l <- ls, n <- ns ] ++ [ l : v | l <- ls, v <- vs ]
                in  vs
            let ls = "abcdehjkpqrstuvxyz"
                ns = map show [1 :: Word .. 99]
                vs = [ l : n | l <- ls, n <- ns ] ++ [ l : v | l <- ls, v <- vs ]
            in  vs
    in  evalStateT
            (runReaderT (fmap fst (runWriterT (inferDefs envGlobDefs defs))) initEnv)
            freshTvs

M src/Inferred.hs => src/Inferred.hs +5 -5
@@ 1,4 1,4 @@
{-# LANGUAGE LambdaCase, TemplateHaskell, DataKinds, TupleSections, DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell, DataKinds #-}

-- | Type annotated AST as a result of typechecking
module Inferred (module Inferred, WithPos(..), TVar(..), TPrim(..), Const(..)) where


@@ 11,7 11,6 @@ import Data.Bifunctor
import Lens.Micro.Platform (makeLenses)

import Misc
import Data.Data
import qualified Parsed
import Parsed (TVar(..), Const(..))
import SrcPos


@@ 41,7 40,7 @@ data TypeErr
    | RecursiveVarDef (WithPos String)
    | TypeInstArityMismatch SrcPos String Int Int
    | ConflictingVarDef SrcPos String
    deriving (Show, Data)
    deriving (Show)

type TConst = TypeAst.TConst Type



@@ 51,12 50,13 @@ data Type
    | TConst TConst
    | TFun Type Type
    | TBox Type
    deriving (Show, Eq, Ord, Data)
    deriving (Show, Eq, Ord)

data Scheme = Forall
    { _scmParams :: (Set TVar)
    , _scmBody :: Type
    } deriving (Show, Eq, Data)
    }
    deriving (Show, Eq)
makeLenses ''Scheme

type Id = WithPos String

M src/Lex.hs => src/Lex.hs +6 -5
@@ 1,4 1,4 @@
{-# LANGUAGE FlexibleContexts, LambdaCase, TupleSections, DataKinds #-}
{-# LANGUAGE DataKinds #-}

-- Note: Some parsers are greedy wrt consuming spaces and comments succeding the
--       item, while others are lazy. You'll have to look at the impl to be


@@ 163,7 163,8 @@ small = smallSpecial <|> smallNormal
smallSpecial = keyword' "id@" *> strlit
smallNormal = andSkipSpaceAfter $ liftA2 (:) smallStart identRest
  where
    smallStart = lowerChar <|> otherChar <|> try (oneOf "-+" <* notFollowedBy digitChar)
    smallStart = lowerChar <|> otherChar <|> try
        (oneOf ("-+" :: String) <* notFollowedBy digitChar)

bigSpecial, bigNormal :: Lexer String
bigSpecial = keyword' "id@" *> strlit


@@ 174,14 175,14 @@ identRest :: Lexer String
identRest = many identLetter

identLetter :: Lexer Char
identLetter = letterChar <|> otherChar <|> oneOf "-+:" <|> digitChar
identLetter = letterChar <|> otherChar <|> oneOf ("-+:" :: String) <|> digitChar

otherChar :: Lexer Char
otherChar = satisfy
    (\c -> and
        [ any ($ c) [isMark, isPunctuation, isSymbol]
        , not (elem c "()[]{}")
        , not (elem c "\"-+:•")
        , not (elem c ("()[]{}" :: String))
        , not (elem c ("\"-+:•" :: String))
        ]
    )


M src/Lexd.hs => src/Lexd.hs +1 -3
@@ 1,6 1,4 @@
{-# LANGUAGE LambdaCase, TypeSynonymInstances, FlexibleInstances
           , MultiParamTypeClasses, KindSignatures, DataKinds
           , DeriveDataTypeable #-}
{-# LANGUAGE DataKinds #-}

module Lexd where


M src/Literate.hs => src/Literate.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase #-}

module Literate (untangleOrg) where

import Data.Char

M src/Macro.hs => src/Macro.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase #-}

module Macro (expandMacros) where

import Control.Applicative

M src/Match.hs => src/Match.hs +6 -2
@@ 1,4 1,4 @@
{-# LANGUAGE LambdaCase, TemplateHaskell, TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Implementation of the algorithm described in /ML pattern match compilation
--   and partial evaluation/ by Peter Sestoft. Close to 1:1, and includes the


@@ 49,7 49,11 @@ type MTypeDefs = Map String [String]

type RedundantCases = [SrcPos]

data Env = Env { _tdefs :: MTypeDefs, _tpat :: Type, _exprPos :: SrcPos }
data Env = Env
    { _tdefs :: MTypeDefs
    , _tpat :: Type
    , _exprPos :: SrcPos
    }
makeLenses ''Env

type Match = ReaderT Env (StateT RedundantCases (ExceptT TypeErr Maybe))

M src/Misc.hs => src/Misc.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, LambdaCase, RankNTypes #-}

module Misc where

import Data.List (intercalate)

M src/Monomorphic.hs => src/Monomorphic.hs +3 -4
@@ 1,5 1,4 @@
{-# LANGUAGE TemplateHaskell, LambdaCase, MultiParamTypeClasses
           , FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Monomorphic AST as a result of monomorphization
module Monomorphic (module Monomorphic, TPrim(..), Const(..), VariantIx, Span, tUnit) where


@@ 65,7 64,7 @@ data Expr'
    deriving (Show)

data Expr = Expr (Maybe SrcPos) Expr'
    deriving (Show)
    deriving Show

type Defs = TopologicalOrder Def
data Def = VarDef VarDef | RecDefs RecDefs deriving Show


@@ 76,7 75,7 @@ type Datas = Map TConst [VariantTypes]
type Externs = [(String, Type, SrcPos)]

data Program = Program Defs Datas Externs
    deriving (Show)
    deriving Show


instance TypeAst Type where

M src/Monomorphize.hs => src/Monomorphize.hs +2 -4
@@ 1,6 1,4 @@
{-# LANGUAGE TemplateHaskell, LambdaCase, TupleSections
           , TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses
           , FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Monomorphization
module Monomorphize (monomorphize, builtinExterns) where


@@ 73,7 71,7 @@ monomorphize (Checked.Program (Topo defs) datas externs) =
    instData :: TConst -> ([VariantTypes], [DataInst])
    instData (x, ts) =
        let (tvars, variants) =
                    Map.findWithDefault (ice "instData no such TConst in datas") x datas
                Map.findWithDefault (ice "instData no such TConst in datas") x datas
            s = Map.fromList (zip tvars ts)
            (variants', moreInsts) = runWriter (mapM (mapM (monotype' s)) variants)
        in  (variants', moreInsts)

M src/Parse.hs => src/Parse.hs +1 -1
@@ 1,4 1,4 @@
{-# LANGUAGE FlexibleContexts, LambdaCase, TupleSections, DataKinds #-}
{-# LANGUAGE DataKinds #-}

module Parse (parse) where


M src/Parsed.hs => src/Parsed.hs +5 -8
@@ 1,13 1,10 @@
{-# LANGUAGE LambdaCase, TypeSynonymInstances, FlexibleInstances
           , MultiParamTypeClasses, KindSignatures, DataKinds
           , DeriveDataTypeable #-}
{-# LANGUAGE DataKinds #-}

module Parsed (module Parsed, Const (..), TPrim(..), TConst) where

import qualified Data.Set as Set
import Data.Set (Set)
import Control.Arrow ((>>>))
import Data.Data

import SrcPos
import FreeVars


@@ 18,12 15,12 @@ import Lexd (Const (..))
data IdCase = Big | Small

newtype Id (case' :: IdCase) = Id (WithPos String)
    deriving (Show, Eq, Ord, Data)
    deriving (Show, Eq, Ord)

data TVar
    = TVExplicit (Id 'Small)
    | TVImplicit String
    deriving (Show, Eq, Ord, Data)
    deriving (Show, Eq, Ord)

data Type
    = TVar TVar


@@ 32,10 29,10 @@ data Type
    -- TODO: Remove special case for these two? Is it really needed?
    | TFun Type Type
    | TBox Type
    deriving (Show, Eq, Ord, Data)
    deriving (Show, Eq, Ord)

data Scheme = Forall SrcPos (Set TVar) Type
     deriving (Show, Eq, Data)
    deriving (Show, Eq)

data Pat
    = PConstruction SrcPos (Id 'Big) [Pat]

M src/Parser.hs => src/Parser.hs +11 -4
@@ 1,5 1,4 @@
{-# LANGUAGE FlexibleContexts, LambdaCase, TupleSections, DataKinds
           , GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DataKinds #-}

module Parser where



@@ 18,7 17,11 @@ import Lexd
import Parsed
import Pretty

data Err = Err { errLength :: Word, errPos :: SrcPos, errExpecteds :: Set String }
data Err = Err
    { errLength :: Word
    , errPos :: SrcPos
    , errExpecteds :: Set String
    }
    deriving (Show, Eq)

instance Semigroup Err where


@@ 33,7 36,11 @@ instance Semigroup Err where
instance Monoid Err where
    mempty = Err 0 (SrcPos "<dummy>" 0 0 Nothing) Set.empty

data St = St { stCount :: Word, stOuterPos :: SrcPos, stInput :: [TokenTree] }
data St = St
    { stCount :: Word
    , stOuterPos :: SrcPos
    , stInput :: [TokenTree]
    }

newtype Parser a = Parser (StateT St (Except Err) a)
    deriving (Functor, Applicative, MonadPlus, Monad, MonadError Err, MonadState St)

M src/Pretty.hs => src/Pretty.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase #-}

module Pretty (pretty, Pretty(..)) where

import Prelude hiding (showChar)

M src/Selections.hs => src/Selections.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase, TupleSections #-}

module Selections (Selections, newSelections, select, selectVarBindings) where

import qualified Data.Map as Map

M src/SrcPos.hs => src/SrcPos.hs +8 -12
@@ 1,21 1,17 @@
{-# LANGUAGE DeriveDataTypeable #-}

module SrcPos where

import Text.Megaparsec.Pos
import Data.Data


data SrcPos =
    SrcPos { srcName :: FilePath
           , srcLine :: Word
           , srcColumn :: Word
           , inExpansion :: Maybe SrcPos
           }
    deriving (Show, Eq, Ord, Data)
data SrcPos = SrcPos
    { srcName :: FilePath
    , srcLine :: Word
    , srcColumn :: Word
    , inExpansion :: Maybe SrcPos
    }
    deriving (Show, Eq, Ord)


data WithPos a = WithPos SrcPos a deriving (Data)
data WithPos a = WithPos SrcPos a

class HasPos a where
    getPos :: a -> SrcPos

M src/Subst.hs => src/Subst.hs +0 -2
@@ 1,5 1,3 @@
{-# LANGUAGE LambdaCase #-}

module Subst (Subst, subst, substExpr, substFunMatch, composeSubsts) where

import qualified Data.Map as Map

M src/TypeAst.hs => src/TypeAst.hs +1 -4
@@ 1,11 1,8 @@
{-# LANGUAGE DeriveDataTypeable #-}

-- | This module mostly exists to expost the builtin types via convenient variables,
--   instead of requiring redefinitions or manually typing the strings of TConst's, which
--   would be prone to typo errors.
module TypeAst where

import Data.Data
import Data.Word

data TPrim


@@ 17,7 14,7 @@ data TPrim
    | TF32
    | TF64
    | TF128
    deriving (Show, Eq, Ord, Data)
    deriving (Show, Eq, Ord)

type TConst t = (String, [t])


M stack.yaml => stack.yaml +1 -1
@@ 1,7 1,7 @@
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies.
resolver: lts-16.18
resolver: lts-17.1

# User packages to be built.
packages:

M stack.yaml.lock => stack.yaml.lock +4 -4
@@ 13,7 13,7 @@ packages:
    hackage: llvm-hs-pretty-0.9.0.0@sha256:b7a5de5f3dd97893d19d2b47af1e4dd8d075a5cf57062180a912d1f3ef1def60,1671
snapshots:
- completed:
    size: 532172
    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/18.yaml
    sha256: 4f2a092c6f4869854e8d7435ab98ce5157c641022c3cbfc4c4614ff3db752e62
  original: lts-16.18
    size: 563098
    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/1.yaml
    sha256: 395775c03e66a4286f134d50346b0b6f1432131cf542886252984b4cfa5fef69
  original: lts-17.1

M test/SystemSpec.hs => test/SystemSpec.hs +1 -4
@@ 1,10 1,7 @@
{-# LANGUAGE LambdaCase #-}

module SystemSpec where

import Prelude hiding (lex)

import Data.Data
import Data.Functor
import Control.Monad
import Control.Monad.Except


@@ 43,7 40,7 @@ spec = do
            expectedErr <- runIO $ fmap (drop 3 . head . lines) (readFile (d </> f))
            result <- runIO $ lexAndParse (d </> f)
            it (dropExtension f) $ shouldSatisfy (fmap typecheck result) $ \case
                Just (Left e) -> show (toConstr e) == expectedErr
                Just (Left e) -> head (words (show e)) == expectedErr
                _ -> False
    describe "Examples compile" $ do
        let d = "examples"