Make Meta a simple structure
This commit is contained in:
parent
f701e4bf8a
commit
f38d548c33
|
@ -1,32 +1,15 @@
|
||||||
-- | Error handling and reporting.
|
-- | Error handling and reporting.
|
||||||
module Errors where
|
module Errors where
|
||||||
|
|
||||||
import Data.Generics
|
|
||||||
import Control.Monad.Error
|
|
||||||
|
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
import Metadata
|
import Metadata
|
||||||
|
|
||||||
data OccError = OccError {
|
|
||||||
errorText :: String,
|
|
||||||
errorPos :: Maybe OccSourcePos
|
|
||||||
}
|
|
||||||
deriving (Show, Eq, Typeable, Data)
|
|
||||||
|
|
||||||
type OccErrorT m a = ErrorT OccError m a
|
|
||||||
|
|
||||||
die :: String -> a
|
die :: String -> a
|
||||||
die s = error $ "\n\nError:\n" ++ s
|
die s = error $ "\n\nError:\n" ++ s
|
||||||
|
|
||||||
dieInternal :: Monad m => String -> m a
|
dieInternal :: Monad m => String -> m a
|
||||||
dieInternal s = die $ "Internal error: " ++ s
|
dieInternal s = die $ "Internal error: " ++ s
|
||||||
|
|
||||||
formatPos :: Meta -> String
|
|
||||||
formatPos m
|
|
||||||
= case findSourcePos m of
|
|
||||||
Just o -> show o
|
|
||||||
Nothing -> "?"
|
|
||||||
|
|
||||||
dieP :: Monad m => Meta -> String -> m a
|
dieP :: Monad m => Meta -> String -> m a
|
||||||
dieP m s = die $ formatPos m ++ ": " ++ s
|
dieP m s = die $ show m ++ ": " ++ s
|
||||||
|
|
||||||
|
|
|
@ -62,7 +62,7 @@ overArray :: A.Variable -> (SubscripterFunction -> Maybe (CGen ())) -> CGen ()
|
||||||
overArray var func
|
overArray var func
|
||||||
= do ps <- get
|
= do ps <- get
|
||||||
let A.Array ds _ = fromJust $ typeOfVariable ps var
|
let A.Array ds _ = fromJust $ typeOfVariable ps var
|
||||||
let m = []
|
let m = emptyMeta
|
||||||
specs <- sequence [makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
|
specs <- sequence [makeNonceVariable "i" m A.Int A.VariableName A.Original | _ <- ds]
|
||||||
let indices = [A.Variable m n | A.Specification _ n _ <- specs]
|
let indices = [A.Variable m n | A.Specification _ n _ <- specs]
|
||||||
|
|
||||||
|
@ -668,7 +668,7 @@ declareInit (A.Chan _) var
|
||||||
declareInit t@(A.Array ds t') var
|
declareInit t@(A.Array ds t') var
|
||||||
= Just $ do init <- case t' of
|
= Just $ do init <- case t' of
|
||||||
A.Chan _ ->
|
A.Chan _ ->
|
||||||
do let m = []
|
do let m = emptyMeta
|
||||||
A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
|
A.Specification _ store _ <- makeNonceVariable "storage" m (A.Array ds A.Int) A.VariableName A.Original
|
||||||
let storeV = A.Variable m store
|
let storeV = A.Variable m store
|
||||||
tell ["Channel "]
|
tell ["Channel "]
|
||||||
|
|
|
@ -1,29 +1,24 @@
|
||||||
-- | Metadata.
|
-- | Metadata -- i.e. source position.
|
||||||
module Metadata where
|
module Metadata where
|
||||||
|
|
||||||
import Data.Generics
|
import Data.Generics
|
||||||
import Data.List
|
|
||||||
|
|
||||||
type Meta = [Metadatum]
|
data Meta = Meta {
|
||||||
|
metaFile :: Maybe String,
|
||||||
data OccSourcePos = OccSourcePos String Int Int
|
metaLine :: Int,
|
||||||
|
metaColumn :: Int
|
||||||
|
}
|
||||||
deriving (Eq, Typeable, Data)
|
deriving (Eq, Typeable, Data)
|
||||||
|
|
||||||
instance Show OccSourcePos where
|
emptyMeta :: Meta
|
||||||
show (OccSourcePos file line col) = file ++ ":" ++ show line ++ ":" ++ show col
|
emptyMeta = Meta {
|
||||||
|
metaFile = Nothing,
|
||||||
data Metadatum =
|
metaLine = 0,
|
||||||
MdSourcePos OccSourcePos
|
metaColumn = 0
|
||||||
deriving (Show, Eq, Typeable, Data)
|
}
|
||||||
|
|
||||||
findSourcePos :: Meta -> Maybe OccSourcePos
|
|
||||||
findSourcePos ms
|
|
||||||
= do sps <- find (\x -> case x of MdSourcePos _ -> True
|
|
||||||
otherwise -> False) ms
|
|
||||||
return $ case sps of MdSourcePos sp -> sp
|
|
||||||
|
|
||||||
formatSourcePos :: Meta -> String
|
|
||||||
formatSourcePos m = case findSourcePos m of
|
|
||||||
Just (OccSourcePos f l c) -> "<@" ++ show l ++ ":" ++ show c ++ ">"
|
|
||||||
Nothing -> "<?>"
|
|
||||||
|
|
||||||
|
instance Show Meta where
|
||||||
|
show m =
|
||||||
|
case metaFile m of
|
||||||
|
Just s -> s ++ ":" ++ show (metaLine m) ++ ":" ++ show (metaColumn m)
|
||||||
|
Nothing -> "no source position"
|
||||||
|
|
|
@ -234,15 +234,14 @@ eol = do { whiteSpace; reserved eolMarker } <?> "end of line"
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
--{{{ helper functions
|
--{{{ helper functions
|
||||||
getSourcePos :: OccParser OccSourcePos
|
|
||||||
getSourcePos
|
|
||||||
= do pos <- getPosition
|
|
||||||
return $ OccSourcePos (sourceName pos) (sourceLine pos) (sourceColumn pos)
|
|
||||||
|
|
||||||
md :: OccParser Meta
|
md :: OccParser Meta
|
||||||
md
|
md
|
||||||
= do pos <- getSourcePos
|
= do pos <- getPosition
|
||||||
return [MdSourcePos pos]
|
return Meta {
|
||||||
|
metaFile = Just $ sourceName pos,
|
||||||
|
metaLine = sourceLine pos,
|
||||||
|
metaColumn = sourceColumn pos
|
||||||
|
}
|
||||||
|
|
||||||
tryVX :: OccParser a -> OccParser b -> OccParser a
|
tryVX :: OccParser a -> OccParser b -> OccParser a
|
||||||
tryVX p q = try (do { v <- p; q; return v })
|
tryVX p q = try (do { v <- p; q; return v })
|
||||||
|
@ -1474,6 +1473,6 @@ parseFile file ps
|
||||||
parseProgram :: Monad m => String -> ParseState -> m (A.Process, ParseState)
|
parseProgram :: Monad m => String -> ParseState -> m (A.Process, ParseState)
|
||||||
parseProgram file ps
|
parseProgram file ps
|
||||||
= do (f, ps') <- parseFile file ps
|
= do (f, ps') <- parseFile file ps
|
||||||
return (f $ A.Main [], ps')
|
return (f $ A.Main emptyMeta, ps')
|
||||||
--}}}
|
--}}}
|
||||||
|
|
||||||
|
|
|
@ -38,7 +38,7 @@ doString :: String -> Doc
|
||||||
doString s = text $ show s
|
doString s = text $ show s
|
||||||
|
|
||||||
doMeta :: Meta -> Doc
|
doMeta :: Meta -> Doc
|
||||||
doMeta m = text $ formatSourcePos m
|
doMeta m = text $ show m
|
||||||
|
|
||||||
doAny :: Data a => a -> Doc
|
doAny :: Data a => a -> Doc
|
||||||
doAny = doGeneral `ext1Q` doList `extQ` doString `extQ` doMeta
|
doAny = doGeneral `ext1Q` doList `extQ` doString `extQ` doMeta
|
||||||
|
|
|
@ -12,8 +12,6 @@ that takes several expressions.
|
||||||
|
|
||||||
The show instance for types should produce occam-looking types.
|
The show instance for types should produce occam-looking types.
|
||||||
|
|
||||||
Redo Meta as a structure rather than a list.
|
|
||||||
|
|
||||||
ParseState should be called something more sensible, since most of it has
|
ParseState should be called something more sensible, since most of it has
|
||||||
nothing to do with parsing.
|
nothing to do with parsing.
|
||||||
|
|
||||||
|
|
|
@ -154,7 +154,7 @@ makeConstant m n = A.ExprLiteral m $ A.Literal m A.Int $ A.IntLiteral m (show n)
|
||||||
|
|
||||||
-- | Find the Meta value in an expression.
|
-- | Find the Meta value in an expression.
|
||||||
metaOfExpression :: A.Expression -> Meta
|
metaOfExpression :: A.Expression -> Meta
|
||||||
metaOfExpression e = concat $ gmapQ (mkQ [] findMeta) e
|
metaOfExpression e = head $ gmapQ (mkQ emptyMeta findMeta) e
|
||||||
where
|
where
|
||||||
findMeta :: Meta -> Meta
|
findMeta :: Meta -> Meta
|
||||||
findMeta m = m
|
findMeta m = m
|
||||||
|
|
Loading…
Reference in New Issue
Block a user