~jojo/Carth

2d38bc1c6c2d6f18e1cc5e302cac93737d208b90 — JoJo 1 year, 7 months ago e479b79
Refactor SrcPos a bit
5 files changed, 25 insertions(+), 22 deletions(-)

M src/Check.hs
M src/Codegen.hs
M src/Parse.hs
M src/SrcPos.hs
M src/TypeErr.hs
M src/Check.hs => src/Check.hs +3 -1
@@ 92,7 92,9 @@ checkCtors parent (Parsed.ConstructorDefs cs) =

builtinDataTypes :: Inferred.TypeDefs
builtinDataTypes = Map.fromList $ map
    (\(x, ps, cs) -> (x, (ps, map (first (WithPos dummyPos)) cs)))
    (\(x, ps, cs) ->
        (x, (ps, map (first (WithPos (SrcPos "<builtin>" 0 0))) cs))
    )
    builtinDataTypes'

builtinConstructors :: Inferred.Ctors

M src/Codegen.hs => src/Codegen.hs +5 -7
@@ 339,9 339,8 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), body) = do
                    )
                    (zip fvs [0 ..])
                pure (zip fvs captureVals)
    defineSrcPos funScopeMdRef (SrcPos (SourcePos _fp l c), mdId) = do
        let (line, col) = both unPos (l, c)
            loc =
    defineSrcPos funScopeMdRef (SrcPos _ line col, mdId) = do
        let loc =
                LLOp.DILocation
                    $ LLOp.Location (fromIntegral line) (fromIntegral col)
                    $ funScopeMdRef


@@ 359,8 358,7 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), body) = do
            )
    funMetadataSubprog =
        let
            SrcPos (SourcePos path line' _) = dpos
            line = fromIntegral (unPos line')
            SrcPos path line _ = dpos
            -- TODO: Maybe only define this once and cache MDRef somewhere?
            fileNode =
                let (dir, file) = splitFileName path


@@ 375,12 373,12 @@ genFunDef (name, fvs, dpos, ptv@(TypedVar px pt), body) = do
            , LLSubprog.name = nameSBString name
            , LLSubprog.linkageName = nameSBString name
            , LLSubprog.file = Just (MDInline fileNode)
            , LLSubprog.line = line
            , LLSubprog.line = fromIntegral line
            , LLSubprog.type' = Just
                (MDInline (LLOp.SubroutineType [] 0 []))
            , LLSubprog.localToUnit = True
            , LLSubprog.definition = True
            , LLSubprog.scopeLine = line
            , LLSubprog.scopeLine = fromIntegral line
            , LLSubprog.containingType = Nothing
            , LLSubprog.virtuality = LLOp.NoVirtuality
            , LLSubprog.virtualityIndex = 0

M src/Parse.hs => src/Parse.hs +5 -1
@@ 402,4 402,8 @@ withPos :: Parser a -> Parser (WithPos a)
withPos = liftA2 WithPos getSrcPos

getSrcPos :: Parser SrcPos
getSrcPos = fmap SrcPos getSourcePos
getSrcPos = fmap
    (\(SourcePos f l c) ->
        SrcPos f (fromIntegral (unPos l)) (fromIntegral (unPos c))
    )
    getSourcePos

M src/SrcPos.hs => src/SrcPos.hs +9 -8
@@ 1,21 1,21 @@
module SrcPos
    ( SrcPos(..)
    , SourcePos(..)
    , WithPos(..)
    , HasPos(..)
    , mapPos
    , unpos
    , unPos
    , dummyPos
    , sourcePosPretty
    , prettySrcPos
    )
where

import Text.Megaparsec.Pos


newtype SrcPos = SrcPos SourcePos
    deriving (Show, Eq, Ord)
data SrcPos = SrcPos
    { srcName :: FilePath
    , srcLine :: Word
    , srcColumn :: Word
    } deriving (Show, Eq, Ord)

data WithPos a = WithPos SrcPos a



@@ 39,5 39,6 @@ mapPos f (WithPos p a) = WithPos p (f a)
unpos :: WithPos a -> a
unpos (WithPos _ a) = a

dummyPos :: SrcPos
dummyPos = SrcPos (initialPos "DUMMY")
prettySrcPos :: SrcPos -> String
prettySrcPos (SrcPos f l c) = sourcePosPretty
    (SourcePos f (mkPos (fromIntegral l)) (mkPos (fromIntegral c)))

M src/TypeErr.hs => src/TypeErr.hs +3 -5
@@ 2,8 2,6 @@

module TypeErr (TypeErr(..), printErr) where

import Text.Megaparsec (SourcePos(..), unPos)

import Misc
import SrcPos
import qualified Parsed


@@ 109,9 107,9 @@ printErr = \case
        posd p $ "Conflicting definitions for variable `" ++ x ++ "`."

posd :: SrcPos -> Message -> IO ()
posd (SrcPos pos@(SourcePos f lineN colN)) msg = do
posd (pos@(SrcPos f lineN colN)) msg = do
    src <- readFile f
    let (lineN', colN') = (unPos lineN, unPos colN)
    let (lineN', colN') = (fromIntegral lineN, fromIntegral colN)
        lines' = lines src
        line = if (lineN' <= length lines')
            then lines' !! (lineN' - 1)


@@ 129,7 127,7 @@ posd (SrcPos pos@(SourcePos f lineN colN)) msg = do
            id
            (parseTokenTreeOrRest rest)
    putStrLn $ unlines
        [ sourcePosPretty pos ++ ": Error:"
        [ prettySrcPos pos ++ ": Error:"
        , indent pad ++ "|"
        , lineNS ++ " | " ++ line
        -- Find the span (end-pos) of the item in the source by applying the same