~jojo/Carth

d61bd8e3de2616f050ec0e572e3858c0240a58d5 — JoJo 1 year, 2 months ago 04f38e4
Elim need for mods LLCompunit, LLSubprog with DuplicateRecordFields

They only existed to reexport a subset of LLOp in order to avoid name
collisions in record fields. The language extension
DuplicateRecordFields eliminates the need for this, by using magic to
disambiguate when there are duplicate fields in different records in
the same module.
5 files changed, 49 insertions(+), 61 deletions(-)

M carth.cabal
M src/Codegen.hs
M src/Gen.hs
D src/LLCompunit.hs
D src/LLSubprog.hs
M carth.cabal => carth.cabal +0 -2
@@ 32,8 32,6 @@ library
      Infer
      Inferred
      Literate
      LLCompunit
      LLSubprog
      Match
      Misc
      Monomorphic

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

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


@@ 7,8 7,6 @@ import LLVM.AST hiding (args)
import LLVM.AST.Typed
import LLVM.AST.Type hiding (ptr)
import LLVM.AST.DataLayout
import qualified LLSubprog
import qualified LLCompunit
import qualified LLVM.AST.Operand as LLOp
import qualified LLVM.AST.Type as LLType
import qualified LLVM.AST.Constant as LLConst


@@ 130,31 128,31 @@ codegen layout moduleFilePath (Program (Topo defs) tdefs externs) = runExcept $ 
        , NamedMetadataDefinition "llvm.dbg.cu" [compileUnitId]
        , NamedMetadataDefinition "llvm.module.flags" [debugInfoVersionId]
        ]
    compileUnitDef = LLCompunit.CompileUnit
        { LLCompunit.language = let unstandardized_c = 1 in unstandardized_c
        , LLCompunit.file = MDRef fileId
        , LLCompunit.producer = "carth version alpha"
        , LLCompunit.optimized = False
        , LLCompunit.flags = ""
        , LLCompunit.runtimeVersion = 0
        , LLCompunit.splitDebugFileName = ""
        , LLCompunit.emissionKind = LLOp.FullDebug
        , LLCompunit.enums = []
        , LLCompunit.retainedTypes = []
        , LLCompunit.globals = []
        , LLCompunit.imports = []
        , LLCompunit.macros = []
        , LLCompunit.dWOId = 0
        , LLCompunit.splitDebugInlining = False
        , LLCompunit.debugInfoForProfiling = False
        , LLCompunit.nameTableKind = LLOp.NameTableKindNone
        , LLCompunit.debugBaseAddress = False
    compileUnitDef = LLOp.CompileUnit
        { LLOp.language = let unstandardized_c = 1 in unstandardized_c
        , LLOp.file = MDRef fileId
        , LLOp.producer = "carth version alpha"
        , LLOp.optimized = False
        , LLOp.flags = ""
        , LLOp.runtimeVersion = 0
        , LLOp.splitDebugFileName = ""
        , LLOp.emissionKind = LLOp.FullDebug
        , LLOp.enums = []
        , LLOp.retainedTypes = []
        , LLOp.globals = []
        , LLOp.imports = []
        , LLOp.macros = []
        , LLOp.dWOId = 0
        , LLOp.splitDebugInlining = False
        , LLOp.debugInfoForProfiling = False
        , LLOp.nameTableKind = LLOp.NameTableKindNone
        , LLOp.debugBaseAddress = False
        }
    fileDef =
        let (dir, file) = splitFileName moduleFilePath
        in  LLOp.File { LLSubprog.filename = fromString file
                      , LLSubprog.directory = fromString dir
                      , LLSubprog.checksum = Nothing
        in  LLOp.File { LLOp.filename = fromString file
                      , LLOp.directory = fromString dir
                      , LLOp.checksum = Nothing
                      }

-- | A data-type is a tagged union, and we represent it in LLVM as a struct

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

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


@@ 40,7 40,6 @@ import qualified LLVM.AST.Linkage as LLLink
import qualified LLVM.AST.Visibility as LLVis
import qualified LLVM.AST.IntegerPredicate as LLIPred
import qualified LLVM.AST.FloatingPointPredicate as LLFPred
import qualified LLSubprog

import Misc
import Pretty


@@ 201,32 200,31 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), genBody) = do
            -- TODO: Maybe only define this once and cache MDRef somewhere?
            fileNode =
                    let (dir, file) = splitFileName path
                    in  LLSubprog.File { LLSubprog.filename = fromString file
                                       , LLSubprog.directory = fromString dir
                                       , LLSubprog.checksum = Nothing
                                       }
        in  LLOp.Subprogram
                { LLSubprog.scope = Just (MDInline (LLOp.DIFile fileNode))
                , LLSubprog.name = nameSBString name
                , LLSubprog.linkageName = nameSBString name
                , LLSubprog.file = Just (MDInline fileNode)
                , LLSubprog.line = fromIntegral line
                , LLSubprog.type' = Just (MDInline (LLOp.SubroutineType [] 0 []))
                , LLSubprog.localToUnit = True
                , LLSubprog.definition = True
                , LLSubprog.scopeLine = fromIntegral line
                , LLSubprog.containingType = Nothing
                , LLSubprog.virtuality = LLOp.NoVirtuality
                , LLSubprog.virtualityIndex = 0
                , LLSubprog.thisAdjustment = 0
                , LLSubprog.flags = []
                , LLSubprog.optimized = False
                , LLSubprog.unit = Just compileUnitRef
                , LLSubprog.templateParams = []
                , LLSubprog.declaration = Nothing
                , LLSubprog.retainedNodes = []
                , LLSubprog.thrownTypes = []
                }
                    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
                            , LLOp.file = Just (MDInline fileNode)
                            , LLOp.line = fromIntegral line
                            , LLOp.type' = Just (MDInline (LLOp.SubroutineType [] 0 []))
                            , LLOp.localToUnit = True
                            , LLOp.definition = True
                            , LLOp.scopeLine = fromIntegral line
                            , LLOp.containingType = Nothing
                            , LLOp.virtuality = LLOp.NoVirtuality
                            , LLOp.virtualityIndex = 0
                            , LLOp.thisAdjustment = 0
                            , LLOp.flags = []
                            , LLOp.optimized = False
                            , LLOp.unit = Just compileUnitRef
                            , LLOp.templateParams = []
                            , LLOp.declaration = Nothing
                            , LLOp.retainedNodes = []
                            , LLOp.thrownTypes = []
                            }
    nameSBString = \case
        Name s -> s
        UnName n -> fromString (show n)

D src/LLCompunit.hs => src/LLCompunit.hs +0 -3
@@ 1,3 0,0 @@
module LLCompunit (DICompileUnit(..)) where

import LLVM.AST.Operand (DICompileUnit(..))

D src/LLSubprog.hs => src/LLSubprog.hs +0 -3
@@ 1,3 0,0 @@
module LLSubprog (DISubprogram(..), DIFile(..)) where

import LLVM.AST.Operand (DISubprogram(..), DIFile(..))