diff --git a/Data/Loc.hs b/Data/Loc.hs new file mode 100644 --- /dev/null +++ b/Data/Loc.hs @@ -0,0 +1,228 @@ +-- Copyright (c) 2006-2010 +-- The President and Fellows of Harvard College. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions +-- are met: +-- 1. Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- 2. Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- 3. Neither the name of the University nor the names of its contributors +-- may be used to endorse or promote products derived from this software +-- without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND +-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +-- ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE +-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +-- SUCH DAMAGE. + +-------------------------------------------------------------------------------- +-- | +-- Module : Data.Loc +-- Copyright : (c) Harvard University 2006-2010 +-- License : BSD-style +-- Maintainer : mainland@eecs.harvard.edu +-- +-------------------------------------------------------------------------------- + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.Loc ( + Pos(..), + posFile, + posLine, + posCol, + posCoff, + startPos, + linePos, + advancePos, + + Loc(..), + locStart, + locEnd, + noLoc, + + SrcLoc(..), + noSrcLoc, + + locOf, + + (<-->), + mergeLoc, + + Location(..), + Located(..), + Relocatable(..), + + L(..), + unLoc + ) where + +#ifdef __GLASGOW_HASKELL__ +import Data.Generics (Data(..),Typeable(..)) +#endif +import Data.List (foldl1') +import Data.Symbol + +-- | Position type. +data Pos = -- | file name, line, column and character offset + Pos !Symbol + {-# UNPACK #-} !Int + {-# UNPACK #-} !Int + {-# UNPACK #-} !Int +#ifdef __GLASGOW_HASKELL__ + deriving (Eq, Data, Typeable) +#else + deriving (Eq,Ord,Show) +#endif + +instance Ord Pos where + compare (Pos f1 l1 c1 _) (Pos f2 l2 c2 _) = + compare (f1, l1, c1) (f2, l2, c2) + +-- | Position file. +posFile :: Pos -> String +posFile (Pos f _ _ _) = unintern f + +-- | Position line. +posLine :: Pos -> Int +posLine (Pos _ l _ _) = l + +-- | Position column. +posCol :: Pos -> Int +posCol (Pos _ _ c _) = c + +-- | Position character offset. +posCoff :: Pos -> Int +posCoff (Pos _ _ _ coff) = coff + +startLine :: Int +startLine = 1 + +startCol :: Int +startCol = 0 + +startCoff :: Int +startCoff = 0 + +startPos :: String -> Pos +startPos f = Pos (intern f) startLine startCol startCoff + +linePos :: String -> Int -> Pos +linePos f l = Pos (intern f) l startCol startCoff + +advancePos :: Pos -> Char -> Pos +advancePos (Pos f l _ coff) '\n' = Pos f (l+1) startCol (coff + 1) +advancePos (Pos f l c coff) _ = Pos f l (c + 1) (coff + 1) + +-- | Location type, consisting of a beginning position and an end position. +data Loc = NoLoc + | -- | Beginning and end positions + Loc {-# UNPACK #-} !Pos + {-# UNPACK #-} !Pos +#ifdef __GLASGOW_HASKELL__ + deriving (Eq, Data, Typeable) +#else + deriving (Eq,Ord,Show) +#endif + +-- | Starting position of the location. +locStart :: Loc -> Loc +locStart NoLoc = NoLoc +locStart (Loc p _) = Loc p p + +-- | Ending position of the location. +locEnd :: Loc -> Loc +locEnd NoLoc = NoLoc +locEnd (Loc _ p) = Loc p p + +-- | No location. +noLoc :: Location a => a +noLoc = fromLoc NoLoc + +-- | Source location type. Source location are all equal, which allows AST nodes +-- to be compared modulo location information. +newtype SrcLoc = SrcLoc Loc + deriving (Data, Typeable) + +instance Eq SrcLoc where + _ == _ = True + +instance Ord SrcLoc where + compare _ _ = EQ + +noSrcLoc :: SrcLoc +noSrcLoc = SrcLoc NoLoc + +locOf :: (Located a, Location b) => a -> b +locOf = fromLoc . getLoc + +infixl 6 <--> + +(<-->) :: (Located a, Located b, Location c) + => a -> b -> c +x <--> y = fromLoc $ mergeLoc (getLoc x) (getLoc y) + +mergeLoc :: Loc -> Loc -> Loc +mergeLoc NoLoc l = l +mergeLoc l NoLoc = l +mergeLoc (Loc b1 e1) (Loc b2 e2) = Loc (min b1 b2) (max e1 e2) + +-- | Locations +class Location a where + fromLoc :: Loc -> a + +instance Location Loc where + fromLoc = id + +instance Location SrcLoc where + fromLoc = SrcLoc + +-- | Located values have a location. +class Located a where + getLoc :: a -> Loc + +instance Located a => Located [a] where + getLoc [] = NoLoc + getLoc xs = foldl1' mergeLoc (map getLoc xs) + +instance Located Pos where + getLoc p = Loc p p + +instance Located Loc where + getLoc = id + +instance Located SrcLoc where + getLoc (SrcLoc loc) = loc + +-- | Values that can be relocated +class Relocatable a where + reloc :: Located b => b -> a -> a + +-- | Locations are ignored when performing comparisons. +data L x = L Loc x + +unLoc :: L a -> a +unLoc (L _ a) = a + +instance Eq x => Eq (L x) where + (L _ x) == (L _ y) = x == y + +instance Ord x => Ord (L x) where + compare (L _ x) (L _ y) = compare x y + +instance Located (L a) where + getLoc (L loc _) = loc + +instance Show x => Show (L x) where + show (L _ x) = show x diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2006-2010 + The President and Fellows of Harvard College. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the University nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/srcloc.cabal b/srcloc.cabal new file mode 100644 --- /dev/null +++ b/srcloc.cabal @@ -0,0 +1,28 @@ +name: srcloc +version: 0.1 +cabal-version: >= 1.6 +license: BSD3 +license-file: LICENSE +copyright: (c) 2006-2010 Harvard University +author: Geoffrey Mainland +maintainer: mainland@eecs.harvard.edu +stability: alpha +homepage: http://www.eecs.harvard.edu/~mainland/ +category: Data +synopsis: Data types for managing source code locations. +description: Data types for managing source code locations. + +build-type: Simple + +library + exposed-modules: + Data.Loc + + build-depends: + base >= 4 && < 5, + symbol >= 0.1 && < 0.2, + syb >= 0.1 && < 0.2 + +source-repository head + type: svn + location: http://senseless.eecs.harvard.edu/repos/mainland-projects/srcloc/trunk/