Update to build against llvm-hs-9.0

.gitignore

@@ -11,3 +11,4 @@ includes
 *.epub
 *.agdai
 .stack-work
+dist-newstyle

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2013-2017, Stephen Diehl
+Copyright (c) 2013-2020, Stephen Diehl
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to

README.md

@@ -14,11 +14,11 @@ point for the backend.
 Install
 -------
 
-Check that your installed LLVM version is precisely 5.0.
+Check that your installed LLVM version is precisely 9.0.
 
 ```bash
 $ llvm-config --version
-5.0
+9.0
 ```
 
 To build using stack:
@@ -31,14 +31,13 @@ $ stack exec main
 To build using cabal:
 
 ```bash
-$ cabal sandbox init
-$ cabal install --only-dependencies
-$ cabal build
+$ cabal new-build
 ```
 
 To run:
 
 ```bash
+$ stack run
 $ cabal run
 Preprocessing executable 'standalone' for tutorial-0.2.0.0...
 ; ModuleID = 'my cool jit'

src/Codegen.hs

@@ -1,93 +1,94 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Codegen where
 
+import Control.Applicative
+import Control.Monad.State
 import Data.ByteString.Short
-import Data.Monoid ((<>))
-import Data.Word
-import Data.String
-import Data.List
 import Data.Function
+import Data.List
 import qualified Data.Map as Map
-
-import Control.Applicative
-import Control.Monad.State
-
+import Data.Monoid ((<>))
+import Data.String
+import Data.Word
 import LLVM.AST
-import LLVM.AST.Typed (typeOf)
-import LLVM.AST.AddrSpace
-import LLVM.AST.Type
-import LLVM.AST.Global
 import qualified LLVM.AST as AST
-
-import qualified LLVM.AST.Linkage as L
-import qualified LLVM.AST.Constant as C
+import LLVM.AST.AddrSpace
 import qualified LLVM.AST.Attribute as A
 import qualified LLVM.AST.CallingConvention as CC
+import qualified LLVM.AST.Constant as C
 import qualified LLVM.AST.FloatingPointPredicate as FP
+import LLVM.AST.Global
+import qualified LLVM.AST.Linkage as L
+import LLVM.AST.Type
+import LLVM.AST.Typed (typeOf)
 
 -------------------------------------------------------------------------------
 -- Module Level
 -------------------------------------------------------------------------------
 
 newtype LLVM a = LLVM (State AST.Module a)
-  deriving (Functor, Applicative, Monad, MonadState AST.Module )
+  deriving (Functor, Applicative, Monad, MonadState AST.Module)
 
 runLLVM :: AST.Module -> LLVM a -> AST.Module
 runLLVM mod (LLVM m) = execState m mod
 
 emptyModule :: ShortByteString -> AST.Module
-emptyModule label = defaultModule { moduleName = label }
+emptyModule label = defaultModule {moduleName = label}
 
 addDefn :: Definition -> LLVM ()
 addDefn d = do
   defs <- gets moduleDefinitions
-  modify $ \s -> s { moduleDefinitions = defs ++ [d] }
-
-define ::  Type -> ShortByteString -> [(Type, Name)] -> (Type -> Codegen a) -> LLVM ()
-define retty label argtys body = addDefn $
-  GlobalDefinition $ functionDefaults {
-    name        = Name label
-  , parameters  = ([Parameter ty nm [] | (ty, nm) <- argtys], False)
-  , returnType  = retty
-  , basicBlocks = bls
-  }
+  modify $ \s -> s {moduleDefinitions = defs ++ [d]}
+
+define :: Type -> ShortByteString -> [(Type, Name)] -> (Type -> Codegen a) -> LLVM ()
+define retty label argtys body =
+  addDefn
+    $ GlobalDefinition
+    $ functionDefaults
+      { name = Name label,
+        parameters = ([Parameter ty nm [] | (ty, nm) <- argtys], False),
+        returnType = retty,
+        basicBlocks = bls
+      }
   where
     bls = createBlocks $ execCodegen $ do
       enter <- addBlock entryBlockName
       _ <- setBlock enter
       body ptrThisType
-    ptrThisType = PointerType {
-        pointerReferent = FunctionType {
-            resultType = retty
-          , argumentTypes = map fst argtys
-          , isVarArg = False
-        }
-      , pointerAddrSpace = AddrSpace 0
+    ptrThisType = PointerType
+      { pointerReferent = FunctionType
+          { resultType = retty,
+            argumentTypes = map fst argtys,
+            isVarArg = False
+          },
+        pointerAddrSpace = AddrSpace 0
       }
 
-external ::  Type -> ShortByteString -> [(Type, Name)] -> LLVM ()
-external retty label argtys = addDefn $
-  GlobalDefinition $ functionDefaults {
-    name        = Name label
-  , linkage     = L.External
-  , parameters  = ([Parameter ty nm [] | (ty, nm) <- argtys], False)
-  , returnType  = retty
-  , basicBlocks = []
-  }
+external :: Type -> ShortByteString -> [(Type, Name)] -> LLVM ()
+external retty label argtys =
+  addDefn
+    $ GlobalDefinition
+    $ functionDefaults
+      { name = Name label,
+        linkage = L.External,
+        parameters = ([Parameter ty nm [] | (ty, nm) <- argtys], False),
+        returnType = retty,
+        basicBlocks = []
+      }
 
 fnPtr :: Name -> LLVM Type
 fnPtr nm = findType <$> gets moduleDefinitions
   where
     findType defs =
       case fnDefByName of
-        []   -> error $ "Undefined function: " ++ show nm
+        [] -> error $ "Undefined function: " ++ show nm
         [fn] -> PointerType (typeOf fn) (AddrSpace 0)
-        _    -> error $ "Ambiguous function name: " ++ show nm
+        _ -> error $ "Ambiguous function name: " ++ show nm
       where
-        globalDefs  = [g | GlobalDefinition g <- defs]
-        fnDefByName = [f | f@(Function { name = nm' }) <- globalDefs, nm' == nm]
+        globalDefs = [g | GlobalDefinition g <- defs]
+        fnDefByName = [f | f@(Function {name = nm'}) <- globalDefs, nm' == nm]
 
 ---------------------------------------------------------------------------------
 -- Types
@@ -109,8 +110,8 @@ type Names = Map.Map ShortByteString Int
 uniqueName :: ShortByteString -> Names -> (ShortByteString, Names)
 uniqueName nm ns =
   case Map.lookup nm ns of
-    Nothing -> (nm,  Map.insert nm 1 ns)
-    Just ix -> (nm <> fromString (show ix), Map.insert nm (ix+1) ns)
+    Nothing -> (nm, Map.insert nm 1 ns)
+    Just ix -> (nm <> fromString (show ix), Map.insert nm (ix + 1) ns)
 
 -------------------------------------------------------------------------------
 -- Codegen State
@@ -119,28 +120,30 @@ uniqueName nm ns =
 type SymbolTable = [(ShortByteString, Operand)]
 
 data CodegenState
-  = CodegenState {
-    currentBlock :: Name                     -- Name of the active block to append to
-  , blocks       :: Map.Map Name BlockState  -- Blocks for function
-  , symtab       :: SymbolTable              -- Function scope symbol table
-  , blockCount   :: Int                      -- Count of basic blocks
-  , count        :: Word                     -- Count of unnamed instructions
-  , names        :: Names                    -- Name Supply
-  } deriving Show
+  = CodegenState
+      { currentBlock :: Name, -- Name of the active block to append to
+        blocks :: Map.Map Name BlockState, -- Blocks for function
+        symtab :: SymbolTable, -- Function scope symbol table
+        blockCount :: Int, -- Count of basic blocks
+        count :: Word, -- Count of unnamed instructions
+        names :: Names -- Name Supply
+      }
+  deriving (Show)
 
 data BlockState
-  = BlockState {
-    idx   :: Int                            -- Block index
-  , stack :: [Named Instruction]            -- Stack of instructions
-  , term  :: Maybe (Named Terminator)       -- Block terminator
-  } deriving Show
+  = BlockState
+      { idx :: Int, -- Block index
+        stack :: [Named Instruction], -- Stack of instructions
+        term :: Maybe (Named Terminator) -- Block terminator
+      }
+  deriving (Show)
 
 -------------------------------------------------------------------------------
 -- Codegen Operations
 -------------------------------------------------------------------------------
 
-newtype Codegen a = Codegen { runCodegen :: State CodegenState a }
-  deriving (Functor, Applicative, Monad, MonadState CodegenState )
+newtype Codegen a = Codegen {runCodegen :: State CodegenState a}
+  deriving (Functor, Applicative, Monad, MonadState CodegenState)
 
 sortBlocks :: [(Name, BlockState)] -> [(Name, BlockState)]
 sortBlocks = sortBy (compare `on` (idx . snd))
@@ -169,7 +172,7 @@ execCodegen m = execState (runCodegen m) emptyCodegen
 fresh :: Codegen Word
 fresh = do
   i <- gets count
-  modify $ \s -> s { count = 1 + i }
+  modify $ \s -> s {count = 1 + i}
   return $ i + 1
 
 instr :: Type -> Instruction -> Codegen (Operand)
@@ -178,19 +181,19 @@ instr ty ins = do
   let ref = (UnName n)
   blk <- current
   let i = stack blk
-  modifyBlock (blk { stack = (ref := ins) : i } )
+  modifyBlock (blk {stack = (ref := ins) : i})
   return $ local ty ref
 
 unnminstr :: Instruction -> Codegen ()
 unnminstr ins = do
   blk <- current
   let i = stack blk
-  modifyBlock (blk { stack = (Do ins) : i } )
+  modifyBlock (blk {stack = (Do ins) : i})
 
 terminator :: Named Terminator -> Codegen (Named Terminator)
 terminator trm = do
   blk <- current
-  modifyBlock (blk { term = Just trm })
+  modifyBlock (blk {term = Just trm})
   return trm
 
 -------------------------------------------------------------------------------
@@ -207,15 +210,17 @@ addBlock bname = do
   nms <- gets names
   let new = emptyBlock ix
       (qname, supply) = uniqueName bname nms
-  modify $ \s -> s { blocks = Map.insert (Name qname) new bls
-                   , blockCount = ix + 1
-                   , names = supply
-                   }
+  modify $ \s ->
+    s
+      { blocks = Map.insert (Name qname) new bls,
+        blockCount = ix + 1,
+        names = supply
+      }
   return (Name qname)
 
 setBlock :: Name -> Codegen Name
 setBlock bname = do
-  modify $ \s -> s { currentBlock = bname }
+  modify $ \s -> s {currentBlock = bname}
   return bname
 
 getBlock :: Codegen Name
@@ -224,7 +229,7 @@ getBlock = gets currentBlock
 modifyBlock :: BlockState -> Codegen ()
 modifyBlock new = do
   active <- gets currentBlock
-  modify $ \s -> s { blocks = Map.insert active new (blocks s) }
+  modify $ \s -> s {blocks = Map.insert active new (blocks s)}
 
 current :: Codegen BlockState
 current = do
@@ -241,19 +246,19 @@ current = do
 assign :: ShortByteString -> Operand -> Codegen ()
 assign var x = do
   lcls <- gets symtab
-  modify $ \s -> s { symtab = [(var, x)] ++ lcls }
+  modify $ \s -> s {symtab = [(var, x)] ++ lcls}
 
 getvar :: ShortByteString -> Codegen Operand
 getvar var = do
   syms <- gets symtab
   case lookup var syms of
-    Just x  -> return x
+    Just x -> return x
     Nothing -> error $ "Local variable not in scope: " ++ show var
 
 -------------------------------------------------------------------------------
 
 -- References
-local ::  Type -> Name -> Operand
+local :: Type -> Name -> Operand
 local = LocalReference
 
 global :: Type -> Name -> C.Constant
@@ -264,16 +269,16 @@ externf ty nm = ConstantOperand (C.GlobalReference ty nm)
 
 -- Arithmetic and Constants
 fadd :: Operand -> Operand -> Codegen Operand
-fadd a b = instr float $ FAdd NoFastMathFlags a b []
+fadd a b = instr float $ FAdd noFastMathFlags a b []
 
 fsub :: Operand -> Operand -> Codegen Operand
-fsub a b = instr float $ FSub NoFastMathFlags a b []
+fsub a b = instr float $ FSub noFastMathFlags a b []
 
 fmul :: Operand -> Operand -> Codegen Operand
-fmul a b = instr float $ FMul NoFastMathFlags a b []
+fmul a b = instr float $ FMul noFastMathFlags a b []
 
 fdiv :: Operand -> Operand -> Codegen Operand
-fdiv a b = instr float $ FDiv NoFastMathFlags a b []
+fdiv a b = instr float $ FDiv noFastMathFlags a b []
 
 fcmp :: FP.FloatingPointPredicate -> Operand -> Operand -> Codegen Operand
 fcmp cond a b = instr float $ FCmp cond a b []