{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  ./Common/Id.hs
Description :  positions, simple and mixfix identifiers
Copyright   :  (c) Klaus Luettich and Christian Maeder and Uni Bremen 2002-2003
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

This module supplies positions, simple and mixfix identifiers.
A simple identifier is a lexical token given by a string and a start position.

-  A 'place' is a special token within mixfix identifiers.

-  A mixfix identifier may have a compound list.
   This compound list follows the last non-place token!

-  Identifiers fixed for all logics
-}

module Common.Id where

import Data.Char
import Data.Data
import Data.List (isPrefixOf)
import Data.Ratio
import qualified Data.Set as Set

-- do use in data types that derive d directly
data Pos = SourcePos
  { Pos -> String
sourceName :: String
  , Pos -> Int
sourceLine :: !Int
  , Pos -> Int
sourceColumn :: !Int
  } deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos =>
(Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
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 :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
$cp1Ord :: Eq Pos
Ord, Typeable, Typeable Pos
Constr
DataType
Typeable Pos =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> Constr
Pos -> DataType
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cSourcePos :: Constr
$tPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cp1Data :: Typeable Pos
Data)

instance Show Pos where
    showsPrec :: Int -> Pos -> ShowS
showsPrec _ = Pos -> ShowS
showPos

-- | position lists with trivial equality
newtype Range = Range { Range -> [Pos]
rangeToList :: [Pos] }
  deriving (Typeable, Typeable Range
Constr
DataType
Typeable Range =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Range -> c Range)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Range)
-> (Range -> Constr)
-> (Range -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Range))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range))
-> ((forall b. Data b => b -> b) -> Range -> Range)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r)
-> (forall u. (forall d. Data d => d -> u) -> Range -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Range -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Range -> m Range)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Range -> m Range)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Range -> m Range)
-> Data Range
Range -> Constr
Range -> DataType
(forall b. Data b => b -> b) -> Range -> Range
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Range -> u
forall u. (forall d. Data d => d -> u) -> Range -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Range -> m Range
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Range)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
$cRange :: Constr
$tRange :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapMp :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapM :: (forall d. Data d => d -> m d) -> Range -> m Range
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Range -> m Range
gmapQi :: Int -> (forall d. Data d => d -> u) -> Range -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Range -> u
gmapQ :: (forall d. Data d => d -> u) -> Range -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Range -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Range -> r
gmapT :: (forall b. Data b => b -> b) -> Range -> Range
$cgmapT :: (forall b. Data b => b -> b) -> Range -> Range
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Range)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Range)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Range)
dataTypeOf :: Range -> DataType
$cdataTypeOf :: Range -> DataType
toConstr :: Range -> Constr
$ctoConstr :: Range -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Range
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Range -> c Range
$cp1Data :: Typeable Range
Data)

-- let InlineAxioms recognize positions
instance Show Range where
    show :: Range -> String
show _ = "nullRange"

-- ignore all ranges in comparisons
instance Eq Range where
    _ == :: Range -> Range -> Bool
== _ = Bool
True

-- Ord must be consistent with Eq
instance Ord Range where
   compare :: Range -> Range -> Ordering
compare _ _ = Ordering
EQ

nullRange :: Range
nullRange :: Range
nullRange = [Pos] -> Range
Range []

isNullRange :: Range -> Bool
isNullRange :: Range -> Bool
isNullRange = [Pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Pos] -> Bool) -> (Range -> [Pos]) -> Range -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> [Pos]
rangeToList

appRange :: Range -> Range -> Range
appRange :: Range -> Range -> Range
appRange (Range l1 :: [Pos]
l1) (Range l2 :: [Pos]
l2) = [Pos] -> Range
Range ([Pos] -> Range) -> [Pos] -> Range
forall a b. (a -> b) -> a -> b
$ [Pos]
l1 [Pos] -> [Pos] -> [Pos]
forall a. [a] -> [a] -> [a]
++ [Pos]
l2

concatMapRange :: (a -> Range) -> [a] -> Range
concatMapRange :: (a -> Range) -> [a] -> Range
concatMapRange f :: a -> Range
f = [Pos] -> Range
Range ([Pos] -> Range) -> ([a] -> [Pos]) -> [a] -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Pos]) -> [a] -> [Pos]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Range -> [Pos]
rangeToList (Range -> [Pos]) -> (a -> Range) -> a -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range
f)

-- | construct a new position
newPos :: String -> Int -> Int -> Pos
newPos :: String -> Int -> Int -> Pos
newPos = String -> Int -> Int -> Pos
SourcePos

-- | increment the column counter
incSourceColumn :: Pos -> Int -> Pos
incSourceColumn :: Pos -> Int -> Pos
incSourceColumn (SourcePos s :: String
s l :: Int
l c :: Int
c) = String -> Int -> Int -> Pos
SourcePos String
s Int
l (Int -> Pos) -> (Int -> Int) -> Int -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+)

-- | show a position
showPos :: Pos -> ShowS
showPos :: Pos -> ShowS
showPos p :: Pos
p = let name :: String
name = Pos -> String
sourceName Pos
p
                line :: Int
line = Pos -> Int
sourceLine Pos
p
                column :: Int
column = Pos -> Int
sourceColumn Pos
p
            in Bool -> ShowS -> ShowS
noShow (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name) (String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ':') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               Bool -> ShowS -> ShowS
noShow (Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Int
column Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
                          (Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
line ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar '.' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
column)

-- * Tokens as 'String's with positions that are ignored for 'Eq' and 'Ord'

-- | tokens as supplied by the scanner
data Token = Token { Token -> String
tokStr :: String
                   , Token -> Range
tokPos :: Range
                   } deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Eq Token =>
(Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
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 :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
$cp1Ord :: Eq Token
Ord, Typeable, Typeable Token
Constr
DataType
Typeable Token =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Token -> c Token)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Token)
-> (Token -> Constr)
-> (Token -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Token))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token))
-> ((forall b. Data b => b -> b) -> Token -> Token)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r)
-> (forall u. (forall d. Data d => d -> u) -> Token -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Token -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Token -> m Token)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Token -> m Token)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Token -> m Token)
-> Data Token
Token -> Constr
Token -> DataType
(forall b. Data b => b -> b) -> Token -> Token
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Token -> u
forall u. (forall d. Data d => d -> u) -> Token -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Token -> m Token
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Token)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
$cToken :: Constr
$tToken :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Token -> m Token
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapMp :: (forall d. Data d => d -> m d) -> Token -> m Token
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapM :: (forall d. Data d => d -> m d) -> Token -> m Token
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Token -> m Token
gmapQi :: Int -> (forall d. Data d => d -> u) -> Token -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Token -> u
gmapQ :: (forall d. Data d => d -> u) -> Token -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Token -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Token -> r
gmapT :: (forall b. Data b => b -> b) -> Token -> Token
$cgmapT :: (forall b. Data b => b -> b) -> Token -> Token
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Token)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Token)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Token)
dataTypeOf :: Token -> DataType
$cdataTypeOf :: Token -> DataType
toConstr :: Token -> Constr
$ctoConstr :: Token -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Token
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Token -> c Token
$cp1Data :: Typeable Token
Data)

instance Show Token where
  show :: Token -> String
show = Token -> String
tokStr

instance Read Token where
  readsPrec :: Int -> ReadS Token
readsPrec i :: Int
i = ((String, String) -> (Token, String))
-> [(String, String)] -> [(Token, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a :: String
a, r :: String
r) -> (String -> Token
mkSimpleId String
a, String
r)) ([(String, String)] -> [(Token, String)])
-> (String -> [(String, String)]) -> ReadS Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(String, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i

-- | simple ids are just tokens
type SIMPLE_ID = Token

-- | construct a token without position from a string
mkSimpleId :: String -> Token
mkSimpleId :: String -> Token
mkSimpleId s :: String
s = String -> Range -> Token
Token String
s Range
nullRange

-- | add a string to a token
addStringToTok :: Token -> String -> Token 
addStringToTok :: Token -> String -> Token
addStringToTok (Token s :: String
s r :: Range
r) s' :: String
s' = String -> Range -> Token
Token (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s') Range
r
 
-- | null token
nullTok :: Token
nullTok :: Token
nullTok = String -> Token
mkSimpleId ""

-- | create a numbered string
mkNumStr :: String -> Int -> String
mkNumStr :: String -> Int -> String
mkNumStr str :: String
str n :: Int
n = String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

-- | create a numbered simple identifier (for variables)
mkNumVar :: String -> Int -> Token
mkNumVar :: String -> Int -> Token
mkNumVar str :: String
str = String -> Token
mkSimpleId (String -> Token) -> (Int -> String) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
mkNumStr String
str

-- | test if the first character indicates a legal simple CASL identifier
isSimpleToken :: Token -> Bool
isSimpleToken :: Token -> Bool
isSimpleToken t :: Token
t = case Token -> String
tokStr Token
t of
    c :: Char
c : r :: String
r -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
&& String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''
    "" -> Bool
False

-- | collect positions
catPosAux :: [Token] -> [Pos]
catPosAux :: [Token] -> [Pos]
catPosAux = (Token -> [Pos]) -> [Token] -> [Pos]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Range -> [Pos]
rangeToList (Range -> [Pos]) -> (Token -> Range) -> Token -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Range
forall a. GetRange a => a -> Range
getRange)

-- | collect positions as range
catRange :: [Token] -> Range
catRange :: [Token] -> Range
catRange = [Pos] -> Range
Range ([Pos] -> Range) -> ([Token] -> [Pos]) -> [Token] -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> [Pos]
catPosAux

-- | shortcut to get positions of surrounding and interspersed tokens
toRange :: Token -> [Token] -> Token -> Range
toRange :: Token -> [Token] -> Token -> Range
toRange o :: Token
o l :: [Token]
l c :: Token
c = [Token] -> Range
catRange ([Token] -> Range) -> [Token] -> Range
forall a b. (a -> b) -> a -> b
$ Token
o Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
l [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
c]

-- * placeholder stuff

-- | the special 'place'
place :: String
place :: String
place = "__"

-- | is a 'place' token
isPlace :: Token -> Bool
isPlace :: Token -> Bool
isPlace (Token t :: String
t _) = String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
place

placeTok :: Token
placeTok :: Token
placeTok = String -> Token
mkSimpleId String
place

-- * equality symbols

-- | also a definition indicator
equalS :: String
equalS :: String
equalS = "="

-- | mind spacing i.e. in @e =e= e@
exEqual :: String
exEqual :: String
exEqual = "=e="

-- | token for type annotations
typeTok :: Token
typeTok :: Token
typeTok = String -> Token
mkSimpleId ":"

-- * mixfix identifiers with compound lists and its range

-- | mixfix and compound identifiers
data Id = Id
    { Id -> [Token]
getTokens :: [Token]
    , Id -> [Id]
getComps :: [Id]
    , Id -> Range
rangeOfId :: Range }
    deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c== :: Id -> Id -> Bool
Eq, Eq Id
Eq Id =>
(Id -> Id -> Ordering)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Bool)
-> (Id -> Id -> Id)
-> (Id -> Id -> Id)
-> Ord Id
Id -> Id -> Bool
Id -> Id -> Ordering
Id -> Id -> Id
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 :: Id -> Id -> Id
$cmin :: Id -> Id -> Id
max :: Id -> Id -> Id
$cmax :: Id -> Id -> Id
>= :: Id -> Id -> Bool
$c>= :: Id -> Id -> Bool
> :: Id -> Id -> Bool
$c> :: Id -> Id -> Bool
<= :: Id -> Id -> Bool
$c<= :: Id -> Id -> Bool
< :: Id -> Id -> Bool
$c< :: Id -> Id -> Bool
compare :: Id -> Id -> Ordering
$ccompare :: Id -> Id -> Ordering
$cp1Ord :: Eq Id
Ord, Typeable, Typeable Id
Constr
DataType
Typeable Id =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Id -> c Id)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Id)
-> (Id -> Constr)
-> (Id -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Id))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Id))
-> ((forall b. Data b => b -> b) -> Id -> Id)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r)
-> (forall u. (forall d. Data d => d -> u) -> Id -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Id -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Id -> m Id)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Id -> m Id)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Id -> m Id)
-> Data Id
Id -> Constr
Id -> DataType
(forall b. Data b => b -> b) -> Id -> Id
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Id -> c Id
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Id
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Id -> u
forall u. (forall d. Data d => d -> u) -> Id -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Id -> m Id
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Id -> m Id
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Id
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Id -> c Id
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Id)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Id)
$cId :: Constr
$tId :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Id -> m Id
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Id -> m Id
gmapMp :: (forall d. Data d => d -> m d) -> Id -> m Id
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Id -> m Id
gmapM :: (forall d. Data d => d -> m d) -> Id -> m Id
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Id -> m Id
gmapQi :: Int -> (forall d. Data d => d -> u) -> Id -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Id -> u
gmapQ :: (forall d. Data d => d -> u) -> Id -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Id -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Id -> r
gmapT :: (forall b. Data b => b -> b) -> Id -> Id
$cgmapT :: (forall b. Data b => b -> b) -> Id -> Id
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Id)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Id)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Id)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Id)
dataTypeOf :: Id -> DataType
$cdataTypeOf :: Id -> DataType
toConstr :: Id -> Constr
$ctoConstr :: Id -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Id
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Id
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Id -> c Id
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Id -> c Id
$cp1Data :: Typeable Id
Data)
    -- pos of square brackets and commas of a compound list

instance Show Id where
  showsPrec :: Int -> Id -> ShowS
showsPrec _ = Id -> ShowS
showId

isNullId :: Id -> Bool
isNullId :: Id -> Bool
isNullId (Id ts :: [Token]
ts cs :: [Id]
cs r :: Range
r) = [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
ts Bool -> Bool -> Bool
&& [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs Bool -> Bool -> Bool
&& Range -> Bool
isNullRange Range
r

-- | construct an 'Id' from a token list
mkId :: [Token] -> Id
mkId :: [Token] -> Id
mkId toks :: [Token]
toks = [Token] -> [Id] -> Range -> Id
Id [Token]
toks [] Range
nullRange

mkInfix :: String -> Id
mkInfix :: String -> Id
mkInfix s :: String
s = [Token] -> Id
mkId [Token
placeTok, String -> Token
mkSimpleId String
s, Token
placeTok]

-- | a prefix for generated names
genNamePrefix :: String
genNamePrefix :: String
genNamePrefix = "gn_"

-- | create a generated simple identifier
genToken :: String -> Token
genToken :: String -> Token
genToken = String -> Token
mkSimpleId (String -> Token) -> ShowS -> String -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
genNamePrefix String -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | create a generated, numbered variable
genNumVar :: String -> Int -> Token
genNumVar :: String -> Int -> Token
genNumVar str :: String
str = String -> Token
genToken (String -> Token) -> (Int -> String) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
mkNumStr String
str

-- | create a generated identifier
genName :: String -> Id
genName :: String -> Id
genName str :: String
str = [Token] -> Id
mkId [String -> Token
genToken String
str]

-- | create a generated identifier from a given one excluding characters
mkGenName :: Id -> Id
mkGenName :: Id -> Id
mkGenName i :: Id
i@(Id ts :: [Token]
ts cs :: [Id]
cs r :: Range
r) = case [Token]
ts of
  t :: Token
t : s :: [Token]
s -> let st :: String
st = Token -> String
tokStr Token
t in case String
st of
    c :: Char
c : _ | Char -> Bool
isAlphaNum Char
c -> [Token] -> [Id] -> Range -> Id
Id (String -> Token
genToken String
st Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
s) [Id]
cs Range
r
          | Token -> Bool
isPlace Token
t -> [Token] -> [Id] -> Range -> Id
Id (String -> Token
mkSimpleId "gn" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts) [Id]
cs Range
r
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' -> Id
i
    _ -> [Token] -> [Id] -> Range -> Id
Id (String -> Token
mkSimpleId "gn_n" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
ts) [Id]
cs Range
r
  _ -> Id
i

-- | tests whether a Token is already a generated one
isGeneratedToken :: Token -> Bool
isGeneratedToken :: Token -> Bool
isGeneratedToken = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
genNamePrefix (String -> Bool) -> (Token -> String) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> String
tokStr

{- | append a number to the first token of a (possible compound) Id,
   or generate a new identifier for /invisible/ ones -}
appendString :: Id -> String -> Id
appendString :: Id -> String -> Id
appendString (Id tokList :: [Token]
tokList idList :: [Id]
idList range :: Range
range) s :: String
s = let
  isAlphaToken :: Token -> Bool
isAlphaToken tok :: Token
tok = case Token -> String
tokStr Token
tok of
    c :: Char
c : _ -> Char -> Bool
isAlpha Char
c
    "" -> Bool
False
  genTok :: [Token] -> [Token] -> String -> [Token]
genTok tList :: [Token]
tList tList1 :: [Token]
tList1 str :: String
str = case [Token]
tList of
    [] -> [String -> Token
mkSimpleId (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ String
genNamePrefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ "n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str]
          -- for invisible identifiers
    tok :: Token
tok : tokens :: [Token]
tokens ->
       if Token -> Bool
isPlace Token
tok Bool -> Bool -> Bool
|| Bool -> Bool
not (Token -> Bool
isAlphaToken Token
tok)
       then [Token] -> [Token] -> String -> [Token]
genTok [Token]
tokens (Token
tok Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
tList1) String
str
       else [Token] -> [Token]
forall a. [a] -> [a]
reverse [Token]
tList1 [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++
           [Token
tok {tokStr :: String
tokStr = -- avoid gn_gn_
                (if Token -> Bool
isGeneratedToken Token
tok then "" else String
genNamePrefix)
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Token -> String
tokStr Token
tok String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str}]
                 {- only underline words may be
                    prefixed with genNamePrefix or extended with a number -}
           [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
tokens
 in [Token] -> [Id] -> Range -> Id
Id ([Token] -> [Token] -> String -> [Token]
genTok [Token]
tokList [] String
s) [Id]
idList Range
range

-- | prepend a string to the first token of an Id
prependString :: String -> Id -> Id
prependString :: String -> Id -> Id
prependString s :: String
s (Id [] comps :: [Id]
comps range :: Range
range) =
  [Token] -> [Id] -> Range -> Id
Id [String -> Range -> Token
Token String
s Range
nullRange] [Id]
comps Range
range
prependString s :: String
s (Id (Token t :: String
t range1 :: Range
range1:toks :: [Token]
toks) comps :: [Id]
comps range2 :: Range
range2) =
  [Token] -> [Id] -> Range -> Id
Id (String -> Range -> Token
Token (String
sString -> ShowS
forall a. [a] -> [a] -> [a]
++String
t) Range
range1Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[Token]
toks) [Id]
comps Range
range2

-- | append two Ids
appendId :: Id -> Id -> Id
appendId :: Id -> Id -> Id
appendId i1 :: Id
i1 i2 :: Id
i2 =
  [Token] -> [Id] -> Range -> Id
Id (Id -> [Token]
getTokens Id
i1 [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ Id -> [Token]
getTokens Id
i2)
     (Id -> [Id]
getComps Id
i1 [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ Id -> [Id]
getComps Id
i2)
     (Range -> Range -> Range
appRange (Id -> Range
rangeOfId Id
i1) (Id -> Range
rangeOfId Id
i2))

-- | the name of injections
injToken :: Token
injToken :: Token
injToken = String -> Token
genToken "inj"

injName :: Id
injName :: Id
injName = [Token] -> Id
mkId [Token
injToken]

mkUniqueName :: Token -> [Id] -> Id
mkUniqueName :: Token -> [Id] -> Id
mkUniqueName t :: Token
t is :: [Id]
is =
    [Token] -> [Id] -> Range -> Id
Id [(Token -> Token -> Token) -> Token -> [Token] -> Token
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (Token s1 :: String
s1 r1 :: Range
r1) (Token s2 :: String
s2 r2 :: Range
r2) ->
                String -> Range -> Token
Token (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2) (Range -> Token) -> Range -> Token
forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
appRange Range
r1 Range
r2) Token
t
        ([Token] -> Token) -> [Token] -> Token
forall a b. (a -> b) -> a -> b
$ (Id -> [Token]) -> [Id] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Id -> [Token]
getTokens [Id]
is]
    (let css :: [[Id]]
css = ([Id] -> Bool) -> [[Id]] -> [[Id]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Id] -> Bool) -> [Id] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Id]] -> [[Id]]) -> [[Id]] -> [[Id]]
forall a b. (a -> b) -> a -> b
$ (Id -> [Id]) -> [Id] -> [[Id]]
forall a b. (a -> b) -> [a] -> [b]
map Id -> [Id]
getComps [Id]
is
     in case [[Id]]
css of
          [] -> []
          h :: [Id]
h : r :: [[Id]]
r -> if ([Id] -> Bool) -> [[Id]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Id] -> [Id] -> Bool
forall a. Eq a => a -> a -> Bool
== [Id]
h) [[Id]]
r then [Id]
h else [[Id]] -> [Id]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Id]]
css)
    ((Range -> Range -> Range) -> Range -> [Range] -> Range
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Range -> Range -> Range
appRange Range
nullRange ([Range] -> Range) -> [Range] -> Range
forall a b. (a -> b) -> a -> b
$ (Id -> Range) -> [Id] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Range
rangeOfId [Id]
is)

-- | the name of projections
projToken :: Token
projToken :: Token
projToken = String -> Token
genToken "proj"

projName :: Id
projName :: Id
projName = [Token] -> Id
mkId [Token
projToken]

mkUniqueProjName :: Id -> Id -> Id
mkUniqueProjName :: Id -> Id -> Id
mkUniqueProjName from :: Id
from to :: Id
to = Token -> [Id] -> Id
mkUniqueName Token
projToken [Id
from, Id
to]

mkUniqueInjName :: Id -> Id -> Id
mkUniqueInjName :: Id -> Id -> Id
mkUniqueInjName from :: Id
from to :: Id
to = Token -> [Id] -> Id
mkUniqueName Token
injToken [Id
from, Id
to]

isInjName :: Id -> Bool
isInjName :: Id -> Bool
isInjName = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (Id -> String
forall a. Show a => a -> String
show Id
injName) (String -> Bool) -> (Id -> String) -> Id -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> String
forall a. Show a => a -> String
show

-- | the postfix type identifier
typeId :: Id
typeId :: Id
typeId = [Token] -> Id
mkId [Token
placeTok, Token
typeTok]

-- | the invisible application rule with two places
applId :: Id
applId :: Id
applId = [Token] -> Id
mkId [Token
placeTok, Token
placeTok]

-- | the infix equality identifier
eqId :: Id
eqId :: Id
eqId = String -> Id
mkInfix String
equalS

exEq :: Id
exEq :: Id
exEq = String -> Id
mkInfix String
exEqual

-- ** show stuff

-- | shortcut to suppress output for input condition
noShow :: Bool -> ShowS -> ShowS
noShow :: Bool -> ShowS -> ShowS
noShow b :: Bool
b s :: ShowS
s = if Bool
b then ShowS
forall a. a -> a
id else ShowS
s

-- | intersperse seperators
showSepList :: ShowS -> (a -> ShowS) -> [a] -> ShowS
showSepList :: ShowS -> (a -> ShowS) -> [a] -> ShowS
showSepList s :: ShowS
s f :: a -> ShowS
f l :: [a]
l = case [a]
l of
  [] -> ShowS
forall a. a -> a
id
  [x :: a
x] -> a -> ShowS
f a
x
  x :: a
x : r :: [a]
r -> a -> ShowS
f a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (a -> ShowS) -> [a] -> ShowS
forall a. ShowS -> (a -> ShowS) -> [a] -> ShowS
showSepList ShowS
s a -> ShowS
f [a]
r

-- | shows a compound list
showIds :: [Id] -> ShowS
showIds :: [Id] -> ShowS
showIds is :: [Id]
is = Bool -> ShowS -> ShowS
noShow ([Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
is) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "["
             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> (Id -> ShowS) -> [Id] -> ShowS
forall a. ShowS -> (a -> ShowS) -> [a] -> ShowS
showSepList (String -> ShowS
showString ",") Id -> ShowS
showId [Id]
is
             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "]"

-- | shows an 'Id', puts final places behind a compound list
showId :: Id -> ShowS
showId :: Id -> ShowS
showId (Id ts :: [Token]
ts is :: [Id]
is _) =
        let (toks :: [Token]
toks, places :: [Token]
places) = [Token] -> ([Token], [Token])
splitMixToken [Token]
ts
            showToks :: [Token] -> ShowS
showToks = ShowS -> (Token -> ShowS) -> [Token] -> ShowS
forall a. ShowS -> (a -> ShowS) -> [a] -> ShowS
showSepList ShowS
forall a. a -> a
id ((Token -> ShowS) -> [Token] -> ShowS)
-> (Token -> ShowS) -> [Token] -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String -> ShowS) -> (Token -> String) -> Token -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> String
tokStr
        in [Token] -> ShowS
showToks [Token]
toks ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> ShowS
showIds [Id]
is ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> ShowS
showToks [Token]
places

-- ** splitting identifiers

-- | splits off the front and final places
splitMixToken :: [Token] -> ([Token], [Token])
splitMixToken :: [Token] -> ([Token], [Token])
splitMixToken ts :: [Token]
ts = case [Token]
ts of
  [] -> ([], [])
  h :: Token
h : l :: [Token]
l ->
    let (toks :: [Token]
toks, pls :: [Token]
pls) = [Token] -> ([Token], [Token])
splitMixToken [Token]
l
        in if Token -> Bool
isPlace Token
h Bool -> Bool -> Bool
&& [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
toks
           then ([Token]
toks, Token
h Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
pls)
           else (Token
h Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
toks, [Token]
pls)

{- | return open and closing list bracket and a compound list
   from a bracket 'Id'  (parsed by 'Common.AnnoParser.caslListBrackets') -}
getListBrackets :: Id -> ([Token], [Token], [Id])
getListBrackets :: Id -> ([Token], [Token], [Id])
getListBrackets (Id b :: [Token]
b cs :: [Id]
cs _) =
    let (b1 :: [Token]
b1, rest :: [Token]
rest) = (Token -> Bool) -> [Token] -> ([Token], [Token])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Token -> Bool
isPlace [Token]
b
        b2 :: [Token]
b2 = if [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
rest then []
             else (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isPlace) [Token]
rest
    in ([Token]
b1, [Token]
b2, [Id]
cs)

-- ** reconstructing token lists

{- | reconstruct a list with surrounding strings and interspersed
     commas with proper position information that should be preserved
     by the input function -}
expandPos :: (Token -> a) -> (String, String) -> [a] -> Range -> [a]
{- expandPos f ("{", "}") [a,b] [(1,1), (1,3), 1,5)] =
   [ t"{" , a , t"," , b , t"}" ] where t = f . Token (and proper positions) -}
expandPos :: (Token -> a) -> (String, String) -> [a] -> Range -> [a]
expandPos f :: Token -> a
f (o :: String
o, c :: String
c) ts :: [a]
ts (Range ps :: [Pos]
ps) =
    if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ts then if [Pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pos]
ps then (String -> a) -> [String] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Token -> a
f (Token -> a) -> (String -> Token) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
mkSimpleId) [String
o, String
c]
       else (Token -> a) -> [Token] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Token -> a
f ((String -> Range -> Token) -> [String] -> [Range] -> [Token]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Range -> Token
Token [String
o, String
c] [[Pos] -> Range
Range [[Pos] -> Pos
forall a. [a] -> a
head [Pos]
ps] , [Pos] -> Range
Range [[Pos] -> Pos
forall a. [a] -> a
last [Pos]
ps]])
    else let
      n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
      diff :: Int
diff = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Pos] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pos]
ps
      commas :: t -> [String]
commas j :: t
j = if t
j t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 2 then [String
c] else "," String -> [String] -> [String]
forall a. a -> [a] -> [a]
: t -> [String]
commas (t
j t -> t -> t
forall a. Num a => a -> a -> a
- 1)
      ocs :: [String]
ocs = String
o String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [String]
forall t. (Eq t, Num t) => t -> [String]
commas Int
n
      hsep :: a
hsep : tseps :: [a]
tseps = (Token -> a) -> [Token] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Token -> a
f
        ([Token] -> [a]) -> [Token] -> [a]
forall a b. (a -> b) -> a -> b
$ if Int
diff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then (String -> Pos -> Token) -> [String] -> [Pos] -> [Token]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ s :: String
s p :: Pos
p -> String -> Range -> Token
Token String
s ([Pos] -> Range
Range [Pos
p])) [String]
ocs [Pos]
ps
          else (String -> Token) -> [String] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map String -> Token
mkSimpleId [String]
ocs
    in a
hsep a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> a -> [a]) -> [a] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ t :: a
t s :: a
s -> [a
t, a
s]) [a]
ts [a]
tseps)

{- | reconstruct the token list of an 'Id'
   including square brackets and commas of (nested) compound lists. -}
getPlainTokenList :: Id -> [Token]
getPlainTokenList :: Id -> [Token]
getPlainTokenList = String -> Id -> [Token]
getTokenList String
place

{- | reconstruct the token list of an 'Id'.
   Replace top-level places with the input String -}
getTokenList :: String -> Id -> [Token]
getTokenList :: String -> Id -> [Token]
getTokenList placeStr :: String
placeStr (Id ts :: [Token]
ts cs :: [Id]
cs ps :: Range
ps) =
    let convert :: [Token] -> [Token]
convert = (Token -> Token) -> [Token] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
map (\ t :: Token
t -> if Token -> Bool
isPlace Token
t then Token
t {tokStr :: String
tokStr = String
placeStr} else Token
t)
        {- reconstruct tokens of a compound list
           although positions will be replaced (by scan) -}
        getCompoundTokenList :: [Id] -> Range -> [Token]
getCompoundTokenList comps :: [Id]
comps = [[Token]] -> [Token]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Token]] -> [Token]) -> (Range -> [[Token]]) -> Range -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            (Token -> [Token])
-> (String, String) -> [[Token]] -> Range -> [[Token]]
forall a. (Token -> a) -> (String, String) -> [a] -> Range -> [a]
expandPos (Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: []) ("[", "]") ((Id -> [Token]) -> [Id] -> [[Token]]
forall a b. (a -> b) -> [a] -> [b]
map Id -> [Token]
getPlainTokenList [Id]
comps)
    in if [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs then [Token] -> [Token]
convert [Token]
ts else
       let (toks :: [Token]
toks, pls :: [Token]
pls) = [Token] -> ([Token], [Token])
splitMixToken [Token]
ts in
           [Token] -> [Token]
convert [Token]
toks [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Id] -> Range -> [Token]
getCompoundTokenList [Id]
cs Range
ps [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token] -> [Token]
convert [Token]
pls

-- ** conversion from 'SIMPLE_ID'

-- | a 'SIMPLE_ID' as 'Id'
simpleIdToId :: SIMPLE_ID -> Id
simpleIdToId :: Token -> Id
simpleIdToId sid :: Token
sid = [Token] -> Id
mkId [Token
sid]

-- | a string as 'Id'
stringToId :: String -> Id
stringToId :: String -> Id
stringToId = Token -> Id
simpleIdToId (Token -> Id) -> (String -> Token) -> String -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
mkSimpleId

-- | efficiently test for a singleton list
isSingle :: [a] -> Bool
isSingle :: [a] -> Bool
isSingle l :: [a]
l = case [a]
l of
    [_] -> Bool
True
    _ -> Bool
False

-- | test for a 'SIMPLE_ID'
isSimpleId :: Id -> Bool
isSimpleId :: Id -> Bool
isSimpleId (Id ts :: [Token]
ts cs :: [Id]
cs _) = [Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id]
cs Bool -> Bool -> Bool
&& case [Token]
ts of
    [t :: Token
t] -> Token -> Bool
isSimpleToken Token
t
    _ -> Bool
False

idToSimpleId :: Id -> Token
idToSimpleId :: Id -> Token
idToSimpleId i :: Id
i = case Id
i of
  Id [t :: Token
t] [] _ -> Token
t
  _ -> String -> Token
forall a. HasCallStack => String -> a
error (String -> Token) -> String -> Token
forall a b. (a -> b) -> a -> b
$ "idToSimpleId: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
i

-- ** fixity stuff

-- | number of 'place' in 'Id'
placeCount :: Id -> Int
placeCount :: Id -> Int
placeCount (Id tops :: [Token]
tops _ _) = [Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Token] -> Int) -> [Token] -> Int
forall a b. (a -> b) -> a -> b
$ (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isPlace [Token]
tops

-- | has a 'place'
isMixfix :: Id -> Bool
isMixfix :: Id -> Bool
isMixfix (Id tops :: [Token]
tops _ _) = (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
isPlace [Token]
tops

-- | 'Id' starts with a 'place'
begPlace :: Id -> Bool
begPlace :: Id -> Bool
begPlace (Id toks :: [Token]
toks _ _) = Bool -> Bool
not ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
toks) Bool -> Bool -> Bool
&& Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
head [Token]
toks)

-- | 'Id' ends with a 'place'
endPlace :: Id -> Bool
endPlace :: Id -> Bool
endPlace (Id toks :: [Token]
toks _ _) = Bool -> Bool
not ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
toks) Bool -> Bool -> Bool
&& Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
last [Token]
toks)

-- | starts with a 'place'
isPostfix :: Id -> Bool
isPostfix :: Id -> Bool
isPostfix (Id tops :: [Token]
tops _ _) = Bool -> Bool
not ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
tops) Bool -> Bool -> Bool
&& Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
head [Token]
tops)
                          Bool -> Bool -> Bool
&& Bool -> Bool
not (Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
last [Token]
tops))

-- | starts and ends with a 'place'
isInfix :: Id -> Bool
isInfix :: Id -> Bool
isInfix (Id tops :: [Token]
tops _ _) = Bool -> Bool
not ([Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
tops) Bool -> Bool -> Bool
&& Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
head [Token]
tops)
                        Bool -> Bool -> Bool
&& Token -> Bool
isPlace ([Token] -> Token
forall a. [a] -> a
last [Token]
tops)

-- * position stuff

-- | compute a meaningful position from an 'Id' for diagnostics
posOfId :: Id -> Range
posOfId :: Id -> Range
posOfId (Id ts :: [Token]
ts _ (Range ps :: [Pos]
ps)) =
   [Pos] -> Range
Range ([Pos] -> Range) -> [Pos] -> Range
forall a b. (a -> b) -> a -> b
$ let l :: [Token]
l = (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> Bool
isPlace) [Token]
ts
                       in [Token] -> [Pos]
catPosAux (if [Token] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
l then [Token]
ts
                       -- for invisible "__ __" (only places)
                          else [Token]
l) [Pos] -> [Pos] -> [Pos]
forall a. [a] -> [a] -> [a]
++ [Pos]
ps

-- | compute start and end position of a Token (or leave it empty)
tokenRange :: Token -> [Pos]
tokenRange :: Token -> [Pos]
tokenRange (Token str :: String
str (Range ps :: [Pos]
ps)) = case [Pos]
ps of
    [p :: Pos
p] -> String -> Pos -> [Pos]
mkTokPos String
str Pos
p
    _ -> [Pos]
ps

mkTokPos :: String -> Pos -> [Pos]
mkTokPos :: String -> Pos -> [Pos]
mkTokPos str :: String
str p :: Pos
p = let l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str in
      if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then [Pos
p, Pos -> Int -> Pos
incSourceColumn Pos
p (Int -> Pos) -> Int -> Pos
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1] else [Pos
p]

outerRange :: Range -> [Pos]
outerRange :: Range -> [Pos]
outerRange (Range qs :: [Pos]
qs) = case [Pos]
qs of
  [] -> []
  q :: Pos
q : _ -> let p :: Pos
p = [Pos] -> Pos
forall a. [a] -> a
last [Pos]
qs in if Pos
p Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
q then [Pos
q] else [Pos
q, Pos
p]

sortRange :: [Pos] -> [Pos] -> [Pos]
sortRange :: [Pos] -> [Pos] -> [Pos]
sortRange rs :: [Pos]
rs qs :: [Pos]
qs = case [Pos]
qs of
  [] -> [Pos]
rs
  r :: Pos
r : _ -> let
    ps :: [Pos]
ps = (Pos -> Bool) -> [Pos] -> [Pos]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Pos -> String
sourceName Pos
r) (String -> Bool) -> (Pos -> String) -> Pos -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> String
sourceName) [Pos]
rs
    p :: Pos
p = [Pos] -> Pos
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Pos] -> Pos) -> [Pos] -> Pos
forall a b. (a -> b) -> a -> b
$ [Pos]
ps [Pos] -> [Pos] -> [Pos]
forall a. [a] -> [a] -> [a]
++ [Pos]
qs
    q :: Pos
q = [Pos] -> Pos
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Pos] -> Pos) -> [Pos] -> Pos
forall a b. (a -> b) -> a -> b
$ [Pos]
ps [Pos] -> [Pos] -> [Pos]
forall a. [a] -> [a] -> [a]
++ [Pos]
qs
    in if Pos
p Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
q then [Pos
p] else [Pos
p, Pos
q]

joinRanges :: [[Pos]] -> [Pos]
joinRanges :: [[Pos]] -> [Pos]
joinRanges = ([Pos] -> [Pos] -> [Pos]) -> [Pos] -> [[Pos]] -> [Pos]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Pos] -> [Pos] -> [Pos]
sortRange []

{- | compute start and end position of a declared Id (or leave it empty).
     Do not use for applied identifiers where place holders are replaced. -}
idRange :: Id -> [Pos]
idRange :: Id -> [Pos]
idRange (Id ts :: [Token]
ts _ r :: Range
r) =
    let (fs :: [Token]
fs, rs :: [Token]
rs) = [Token] -> ([Token], [Token])
splitMixToken [Token]
ts
    in [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> [[Pos]] -> [Pos]
forall a b. (a -> b) -> a -> b
$ (Token -> [Pos]) -> [Token] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map Token -> [Pos]
tokenRange [Token]
fs [[Pos]] -> [[Pos]] -> [[Pos]]
forall a. [a] -> [a] -> [a]
++ [Range -> [Pos]
outerRange Range
r] [[Pos]] -> [[Pos]] -> [[Pos]]
forall a. [a] -> [a] -> [a]
++ (Token -> [Pos]) -> [Token] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map Token -> [Pos]
tokenRange [Token]
rs

-- | add components to an Id
addComponents :: Id -> ([Id], Range) -> Id
addComponents :: Id -> ([Id], Range) -> Id
addComponents i :: Id
i (comps :: [Id]
comps,rs :: Range
rs) = Id
i { getComps :: [Id]
getComps = Id -> [Id]
getComps Id
i [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ [Id]
comps
                               , rangeOfId :: Range
rangeOfId = Range -> Range -> Range
appRange (Id -> Range
rangeOfId Id
i) Range
rs}

-- -- helper class -------------------------------------------------------

{- | This class is derivable with DrIFT.
   Its main purpose is to have a function that operates on
   constructors with a 'Range' field. During parsing, mixfix
   analysis and ATermConversion this function might be very useful.
-}

class GetRange a where
    getRange :: a -> Range
    getRange = Range -> a -> Range
forall a b. a -> b -> a
const Range
nullRange
    rangeSpan :: a -> [Pos]
    rangeSpan = [Pos] -> [Pos] -> [Pos]
sortRange [] ([Pos] -> [Pos]) -> (a -> [Pos]) -> a -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Pos]
forall a. GetRange a => a -> [Pos]
getPosList

getPosList :: GetRange a => a -> [Pos]
getPosList :: a -> [Pos]
getPosList = Range -> [Pos]
rangeToList (Range -> [Pos]) -> (a -> Range) -> a -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range
forall a. GetRange a => a -> Range
getRange

getRangeSpan :: GetRange a => a -> Range
getRangeSpan :: a -> Range
getRangeSpan = [Pos] -> Range
Range ([Pos] -> Range) -> (a -> [Pos]) -> a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan

instance GetRange Token where
    getRange :: Token -> Range
getRange = [Pos] -> Range
Range ([Pos] -> Range) -> (Token -> [Pos]) -> Token -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> [Pos]
tokenRange
    rangeSpan :: Token -> [Pos]
rangeSpan = Token -> [Pos]
tokenRange

instance GetRange Id where
    getRange :: Id -> Range
getRange = Id -> Range
posOfId
    rangeSpan :: Id -> [Pos]
rangeSpan = Id -> [Pos]
idRange

instance GetRange Range where
    getRange :: Range -> Range
getRange = Range -> Range
forall a. a -> a
id
    rangeSpan :: Range -> [Pos]
rangeSpan = Range -> [Pos]
outerRange

-- defaults ok
instance GetRange ()
instance GetRange Char
instance GetRange Bool
instance GetRange Int
instance GetRange Integer
instance GetRange (Ratio a) -- for Rational

instance GetRange a => GetRange (Maybe a) where
    getRange :: Maybe a -> Range
getRange = Range -> (a -> Range) -> Maybe a -> Range
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Range
nullRange a -> Range
forall a. GetRange a => a -> Range
getRange
    rangeSpan :: Maybe a -> [Pos]
rangeSpan = [Pos] -> (a -> [Pos]) -> Maybe a -> [Pos]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan

instance GetRange a => GetRange [a] where
    getRange :: [a] -> Range
getRange = (a -> Range) -> [a] -> Range
forall a. (a -> Range) -> [a] -> Range
concatMapRange a -> Range
forall a. GetRange a => a -> Range
getRange
    rangeSpan :: [a] -> [Pos]
rangeSpan = [[Pos]] -> [Pos]
joinRanges ([[Pos]] -> [Pos]) -> ([a] -> [[Pos]]) -> [a] -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Pos]) -> [a] -> [[Pos]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan

instance (GetRange a, GetRange b) => GetRange (a, b) where
    getRange :: (a, b) -> Range
getRange = a -> Range
forall a. GetRange a => a -> Range
getRange (a -> Range) -> ((a, b) -> a) -> (a, b) -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst
    rangeSpan :: (a, b) -> [Pos]
rangeSpan (a :: a
a, b :: b
b) = [Pos] -> [Pos] -> [Pos]
sortRange (a -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan a
a) ([Pos] -> [Pos]) -> [Pos] -> [Pos]
forall a b. (a -> b) -> a -> b
$ b -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan b
b

instance GetRange a => GetRange (Set.Set a) where
    getRange :: Set a -> Range
getRange = [a] -> Range
forall a. GetRange a => a -> Range
getRange ([a] -> Range) -> (Set a -> [a]) -> Set a -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList
    rangeSpan :: Set a -> [Pos]
rangeSpan = [a] -> [Pos]
forall a. GetRange a => a -> [Pos]
rangeSpan ([a] -> [Pos]) -> (Set a -> [a]) -> Set a -> [Pos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList