--  Compiler Toolkit: some basic definitions used all over the place
--
--  Author : Manuel M. T. Chakravarty
--  Created: 16 February 95
--
--  Version $Revision: 1.44 $ from $Date: 2000/10/05 07:51:28 $
--
--  Copyright (c) [1995..2000] Manuel M. T. Chakravarty
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Library General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This module provides some definitions used throughout all modules of a
--  compiler.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--  * May not import anything apart from `Config'.
--
--- TODO ----------------------------------------------------------------------
--

module Position (
  --
  -- source text positions
  --
  Position(Position), Pos (posOf),
  nopos, isNopos,
  dontCarePos,  isDontCarePos,
  builtinPos, isBuiltinPos,
  internalPos, isInternalPos,
  incPos, tabPos, retPos,
) where

import Binary      (Binary(..), putSharedString, getSharedString)

-- uniform representation of source file positions; the order of the arguments
-- is important as it leads to the desired ordering of source positions
-- (EXPORTED)
--
data Position = Position String         -- file name
        {-# UNPACK #-}   !Int           -- row
        {-# UNPACK #-}   !Int           -- column
  deriving (Position -> Position -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
Ord)

instance Show Position where
  show :: Position -> String
show (Position String
fname Int
row Int
col) = forall a. Show a => a -> String
show (String
fname, Int
row, Int
col)

-- no position (for unknown position information) (EXPORTED)
--
nopos :: Position
nopos :: Position
nopos  = String -> Int -> Int -> Position
Position String
"<no file>" (-Int
1) (-Int
1)

isNopos :: Position -> Bool
isNopos :: Position -> Bool
isNopos (Position String
_ (-1) (-1)) = Bool
True
isNopos Position
_                      = Bool
False

-- don't care position (to be used for invalid position information) (EXPORTED)
--
dontCarePos :: Position
dontCarePos :: Position
dontCarePos = String -> Int -> Int -> Position
Position String
"<invalid>" (-Int
2) (-Int
2)

isDontCarePos  :: Position -> Bool
isDontCarePos :: Position -> Bool
isDontCarePos (Position String
_ (-2) (-2)) = Bool
True
isDontCarePos Position
_                      = Bool
False

-- position attached to objects that are hard-coded into the toolkit (EXPORTED)
--
builtinPos :: Position
builtinPos :: Position
builtinPos  = String -> Int -> Int -> Position
Position String
"<built into the compiler>" (-Int
3) (-Int
3)

isBuiltinPos :: Position -> Bool
isBuiltinPos :: Position -> Bool
isBuiltinPos (Position String
_ (-3) (-3)) = Bool
True
isBuiltinPos Position
_                      = Bool
False

-- position used for internal errors (EXPORTED)
--
internalPos :: Position
internalPos :: Position
internalPos = String -> Int -> Int -> Position
Position String
"<internal error>" (-Int
4) (-Int
4)

isInternalPos :: Position -> Bool
isInternalPos :: Position -> Bool
isInternalPos (Position String
_ (-4) (-4)) = Bool
True
isInternalPos Position
_                      = Bool
False

-- instances of the class `Pos' are associated with some source text position
-- don't care position (to be used for invalid position information) (EXPORTED)
--
class Pos a where
  posOf :: a -> Position

-- advance column
--
incPos :: Position -> Int -> Position
incPos :: Position -> Int -> Position
incPos (Position String
fname Int
row Int
col) Int
n = String -> Int -> Int -> Position
Position String
fname Int
row (Int
col forall a. Num a => a -> a -> a
+ Int
n)

-- advance column to next tab positions (tabs are at every 8th column)
--
tabPos :: Position -> Position
tabPos :: Position -> Position
tabPos (Position String
fname Int
row Int
col) =
        String -> Int -> Int -> Position
Position String
fname Int
row (Int
col forall a. Num a => a -> a -> a
+ Int
8 forall a. Num a => a -> a -> a
- (Int
col forall a. Num a => a -> a -> a
- Int
1) forall a. Integral a => a -> a -> a
`mod` Int
8)

-- advance to next line
--
retPos :: Position -> Position
retPos :: Position -> Position
retPos (Position String
fname Int
row Int
col) = String -> Int -> Int -> Position
Position String
fname (Int
row forall a. Num a => a -> a -> a
+ Int
1) Int
1


instance Binary Position where
  put_ :: BinHandle -> Position -> IO ()
put_ BinHandle
bh (Position String
fname Int
row Int
col) = do
    BinHandle -> String -> IO ()
putSharedString BinHandle
bh String
fname
--    put_ bh fname
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
row
    forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
col
  get :: BinHandle -> IO Position
get BinHandle
bh = do
    String
fname <- BinHandle -> IO String
getSharedString BinHandle
bh
--    aa <- get bh
    Int
row <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    Int
col <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Int -> Int -> Position
Position String
fname Int
row Int
col)